[multiple changes]

2007-08-14  Geert Bosch  <bosch@adacore.com>

	* i-forbla.ads, i-forbla.adb, a-ngcoar.adb, a-ngcoar.ads, i-forlap.ads,
	s-gearop.adb, s-gecobl.adb, s-gecobl.ads, s-gerela.adb, s-gerela.ads:
	Add required linker pragmas for automatically linking with the gnalasup
	linear algebra support library, and the systems math library.
	Rename cdot to cdotu and zdot to zdotu.
	Update header comment to describe purpose of package.

2007-08-14  Thomas Quinot  <quinot@adacore.com>

	* exp_ch7.adb (Find_Final_List): For an anonymous access type that has
	an explicitly specified Associated_Final_Chain, use that list.
	(Expand_N_Package_Body): Build dispatch tables of library level tagged
	types.
	(Expand_N_Package_Declaration): Build dispatch tables of library level
	tagged types. Minor code cleanup.

2007-08-14  Vincent Celier  <celier@adacore.com>

	* gnatchop.adb (Terminate_Program): Remove exception and use
	Types.Terminate_Program instead.

	* osint.ads, osint.adb (Current_Exit_Status): New global variable
	(Find_Program_Name): Added protection against empty name.
	(OS_Exit_Through_Exception): New procedure

	* s-os_lib.ads, s-os_lib.adb (OS_Exit): New procedure body
	(OS_Exit_Default): New procedure that contains the previous
	implementation of procedure OS_Exit.
	(Final_Value): Remove obsolete Interix stuff.

2007-08-14  Thomas Quinot  <quinot@adacore.com>

	* g-socket.ads: Reorganize example code so that it also works on
	Windows XP.

2007-08-14  Tristan Gingold  <gingold@adacore.com>

	* g-trasym.ads: AIX now supports symbolic backtraces.

2007-08-14  Ed Schonberg  <schonberg@adacore.com>

	* lib-load.adb (From_Limited_With_Chain): Always scan the stack of
	units being loaded to detect circularities. A circularity may be
	present even if the current chain of pending units to load starts from
	a limited_with_clause.

	* lib-load.ads: Change profile of Load_Unit to use a with_clause
	rather than a boolean flag, in order to detect circularities in
	with_clauses.

	* par-load.adb: Use current with_clause in calls to Load_Unit, rather
	than propagating the From_Limited_With flag, in order to handle
	properly circularities involving with_clauses.

2007-08-14  Nicolas Setton  <setton@adacore.com>

	* link.c (FreeBSD): Add "const" keyword where needed, to eliminate
	warnings.

2007-08-14  Arnaud Charlet  <charlet@adacore.com>

	* Makefile.in: GNATRTL_LINEARALGEBRA_OBJS: New variable holding objects
	to build for libgnala.
	libgnat: Add rules to build libgnala.a
	(LIBGNAT_TARGET_PAIRS for VxWorks): Remove s-osinte-vxworks.adb from
	target pairs of the VxWorks 6 kernel runtime, use it only for VxWorks 5.
	Add s-osinte-vxworks-kernel.adb to the target pairs of the
	kernel run-time lib for VxWorks 6, which would provide a different
	implementation for Task_Cont and Task_Stop than the VxWorks 5 version.
	x86-solaris section (EH_MECHANISM): Set to -gcc, as this port is now
	running ZCX by default.
	Add g-sttsne-locking to LynxOS version.
	Remove g-sttsne-vxworks.ads; use g-sttsne-locking.ads instead.
	On x86/darwin, use a-numaux-x86.ad? and system-darwin-x86.ads.

	* system-darwin-x86.ads: New file.

	* Make-lang.in: Delete files before copying onto them, so if they are
	read-only, the copy won't fail.
	Update dependencies

2007-08-14  Pascal Obry  <obry@adacore.com>

	* mdll-fil.adb, * mdll.adb: Implement a more consistent libraries
	naming scheme.

2007-08-14  Vincent Celier  <celier@adacore.com>

	* mlib-utl.adb (Gcc_Name): Change from constant String to String_Access
	(Gcc): Initialize Gcc_Name at the first call

2007-08-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch7.adb (Analyze_Package_Specification): Do not install private
	with_clauses of the enclosing unit when analyzing the package
	specification of a nested instance.

2007-08-14  Hristian Kirtchev  <kirtchev@adacore.com>

	* sinfo.ads, sinfo.adb (Is_Coextension, Set_Is_Coextension): Removed.
	(Is_Dynamic_Coextension, Set_Is_Dynamic_Coextension): New routines.
	Remove flag Is_Coextension. Add flag Is_Dynamic_Coextension. Update the
	layout of N_Allocator.

2007-08-14  Thomas Quinot  <quinot@adacore.com>

	* rtsfind.adb (Check_RPC): Add PCS version check.

	* gnatvsn.ads, gnatvsn.adb: Add PCS version.
	(Gnat_Free_Software): New function.

	* sem_dist.ads, sem_dist.adb (Get_PCS_Version): New subprogram. Returns
	the PCS_Version value from s-parint, used to check that it is consistent
	with what exp_dist expects.

	* s-parint.ads (PCS_Version): New entity for checking consistency
	between exp_dist and PCS.

	* gen-soccon.c: (SO_REUSEPORT): New constant.

2007-08-14  Hristian Kirtchev  <kirtchev@adacore.com>

	* a-calfor.adb (Image (Duration; Boolean)): Change type of local
	variable Sub_Second to Duration in order to accomodate a larger range
	of arithmetic operations.

2007-08-14  Bob Duff  <duff@adacore.com>

	* g-sttsne-locking.ads: Move comments from spec to body.
	* g-sttsne-locking.adb: Move comments from spec to body.
	* g-sttsne-vxworks.ads: Removed.
	* g-sttsne-vxworks.adb: Removed.

From-SVN: r127467

gcc/ada/Makefile.in

@@ -411,7 +411,7 @@ ifeq ($(strip $(filter-out m68k% wrs vx%,$(targ))),)
   g-socthi.adb<g-socthi-vxworks.adb \
   g-stsifd.adb<g-stsifd-sockets.adb \
   g-sttsne.adb<g-sttsne-vxworks.adb \
-  g-sttsne.ads<g-sttsne-vxworks.ads \
+  g-sttsne.ads<g-sttsne-locking.ads \
   system.ads<system-vxworks-m68k.ads
 
   TOOLS_TARGET_PAIRS=mlib-tgt-specific.adb<mlib-tgt-vxworks.adb
@@ -448,7 +448,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
   g-socthi.adb<g-socthi-vxworks.adb \
   g-stsifd.adb<g-stsifd-sockets.adb \
   g-sttsne.adb<g-sttsne-vxworks.adb \
-  g-sttsne.ads<g-sttsne-vxworks.ads
+  g-sttsne.ads<g-sttsne-locking.ads
 
   TOOLS_TARGET_PAIRS=mlib-tgt-specific.adb<mlib-tgt-vxworks.adb
 
@@ -472,16 +472,17 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
   else
     LIBGNAT_TARGET_PAIRS += \
     s-interr.adb<s-interr-vxworks.adb \
-    s-osinte.adb<s-osinte-vxworks.adb \
     s-tpopsp.adb<s-tpopsp-vxworks.adb \
     system.ads<system-vxworks-ppc.ads
 
     ifeq ($(strip $(filter-out kernel,$(THREAD_KIND))),)
       LIBGNAT_TARGET_PAIRS += \
-      s-osinte.ads<s-osinte-vxworks6.ads
+      s-osinte.ads<s-osinte-vxworks6.ads \
+      s-osinte.adb<s-osinte-vxworks-kernel.adb
     else
       LIBGNAT_TARGET_PAIRS += \
-      s-osinte.ads<s-osinte-vxworks.ads
+      s-osinte.ads<s-osinte-vxworks.ads \
+      s-osinte.adb<s-osinte-vxworks.adb
     endif
 
     EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
@@ -517,7 +518,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
   g-socthi.adb<g-socthi-vxworks.adb \
   g-stsifd.adb<g-stsifd-sockets.adb \
   g-sttsne.adb<g-sttsne-vxworks.adb \
-  g-sttsne.ads<g-sttsne-vxworks.ads \
+  g-sttsne.ads<g-sttsne-locking.ads \
   system.ads<system-vxworks-ppc-vthread.ads
 
   TOOLS_TARGET_PAIRS=mlib-tgt-specific.adb<mlib-tgt-vxworks.adb
@@ -565,7 +566,7 @@ ifeq ($(strip $(filter-out sparc% wrs vx%,$(targ))),)
   g-socthi.adb<g-socthi-vxworks.adb \
   g-stsifd.adb<g-stsifd-sockets.adb \
   g-sttsne.adb<g-sttsne-vxworks.adb \
-  g-sttsne.ads<g-sttsne-vxworks.ads \
+  g-sttsne.ads<g-sttsne-locking.ads \
   system.ads<system-vxworks-sparcv9.ads   \
 
   TOOLS_TARGET_PAIRS=mlib-tgt-specific.adb<mlib-tgt-vxworks.adb
@@ -596,7 +597,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),)
   g-socthi.adb<g-socthi-vxworks.adb \
   g-stsifd.adb<g-stsifd-sockets.adb \
   g-sttsne.adb<g-sttsne-vxworks.adb \
-  g-sttsne.ads<g-sttsne-vxworks.ads
+  g-sttsne.ads<g-sttsne-locking.ads
 
   TOOLS_TARGET_PAIRS=mlib-tgt-specific.adb<mlib-tgt-vxworks.adb
 
@@ -620,16 +621,17 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),)
   else
     LIBGNAT_TARGET_PAIRS += \
     s-interr.adb<s-interr-vxworks.adb \
-    s-osinte.adb<s-osinte-vxworks.adb \
     s-tpopsp.adb<s-tpopsp-vxworks.adb \
     system.ads<system-vxworks-x86.ads
 
     ifeq ($(strip $(filter-out kernel,$(THREAD_KIND))),)
       LIBGNAT_TARGET_PAIRS += \
-      s-osinte.ads<s-osinte-vxworks6.ads
+      s-osinte.ads<s-osinte-vxworks6.ads \
+      s-osinte.adb<s-osinte-vxworks-kernel.adb
     else
       LIBGNAT_TARGET_PAIRS += \
-      s-osinte.ads<s-osinte-vxworks.ads
+      s-osinte.ads<s-osinte-vxworks.ads \
+      s-osinte.adb<s-osinte-vxworks.adb
     endif
 
     EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
@@ -661,7 +663,7 @@ ifeq ($(strip $(filter-out arm% coff wrs vx%,$(targ))),)
   g-socthi.adb<g-socthi-vxworks.adb \
   g-stsifd.adb<g-stsifd-sockets.adb \
   g-sttsne.adb<g-sttsne-vxworks.adb \
-  g-sttsne.ads<g-sttsne-vxworks.ads \
+  g-sttsne.ads<g-sttsne-locking.ads \
   system.ads<system-vxworks-arm.ads
 
   TOOLS_TARGET_PAIRS=mlib-tgt-specific.adb<mlib-tgt-vxworks.adb
@@ -693,7 +695,7 @@ ifeq ($(strip $(filter-out mips% wrs vx%,$(targ))),)
   g-socthi.adb<g-socthi-vxworks.adb \
   g-stsifd.adb<g-stsifd-sockets.adb \
   g-sttsne.adb<g-sttsne-vxworks.adb \
-  g-sttsne.ads<g-sttsne-vxworks.ads \
+  g-sttsne.ads<g-sttsne-locking.ads \
   system.ads<system-vxworks-mips.ads
 
   TOOLS_TARGET_PAIRS=mlib-tgt-specific.adb<mlib-tgt-vxworks.adb
@@ -797,6 +799,7 @@ ifeq ($(strip $(filter-out %86 solaris2%,$(arch) $(osys))),)
 
   TOOLS_TARGET_PAIRS=mlib-tgt-specific.adb<mlib-tgt-solaris.adb
 
+  EH_MECHANISM=-gcc
   THREADSLIB = -lposix4 -lthread
   MISCLIB = -lposix4 -lnsl -lsocket
   SO_OPTS = -Wl,-h,
@@ -1075,6 +1078,8 @@ ifeq ($(strip $(filter-out lynxos,$(osys))),)
     a-intnam.ads<a-intnam-lynxos.ads \
     g-bytswa.adb<g-bytswa-x86.adb \
     g-soccon.ads<g-soccon-lynxos.ads \
+    g-sttsne.adb<g-sttsne-locking.adb \
+    g-sttsne.ads<g-sttsne-locking.ads \
     s-inmaop.adb<s-inmaop-posix.adb \
     s-intman.adb<s-intman-posix.adb \
     s-osinte.adb<s-osinte-lynxos.adb \
@@ -1091,6 +1096,8 @@ ifeq ($(strip $(filter-out lynxos,$(osys))),)
     LIBGNAT_TARGET_PAIRS = \
     a-intnam.ads<a-intnam-lynxos.ads \
     g-soccon.ads<g-soccon-lynxos.ads \
+    g-sttsne.adb<g-sttsne-locking.adb \
+    g-sttsne.ads<g-sttsne-locking.ads \
     s-inmaop.adb<s-inmaop-posix.adb \
     s-intman.adb<s-intman-posix.adb \
     s-osinte.adb<s-osinte-lynxos.adb \
@@ -1465,22 +1472,38 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
   LIBRARY_VERSION := $(LIB_VERSION)
 endif
 
-ifeq ($(strip $(filter-out powerpc darwin%,$(arch) $(osys))),)
-  LIBGNAT_TARGET_PAIRS = \
-  a-intnam.ads<a-intnam-darwin.ads \
-  a-numaux.ads<a-numaux-darwin.ads \
-  a-numaux.adb<a-numaux-darwin.adb \
-  g-soccon.ads<g-soccon-darwin.ads \
-  i-forbla.adb<i-forbla-darwin.adb \
-  s-inmaop.adb<s-inmaop-posix.adb \
-  s-intman.adb<s-intman-posix.adb \
-  s-osinte.adb<s-osinte-darwin.adb \
-  s-osinte.ads<s-osinte-darwin.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-foreign.adb \
-  system.ads<system-darwin-ppc.ads
+ifeq ($(strip $(filter-out darwin%,$(osys))),)
+  ifeq ($(strip $(filter-out %86,$(arch))),)
+    LIBGNAT_TARGET_PAIRS = \
+    a-intnam.ads<a-intnam-darwin.ads \
+    s-inmaop.adb<s-inmaop-posix.adb \
+    s-intman.adb<s-intman-posix.adb \
+    s-osinte.adb<s-osinte-darwin.adb \
+    s-osinte.ads<s-osinte-darwin.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-foreign.adb \
+    g-soccon.ads<g-soccon-darwin.ads \
+    a-numaux.ads<a-numaux-x86.ads \
+    a-numaux.adb<a-numaux-x86.adb \
+    system.ads<system-darwin-x86.ads
+  else
+    LIBGNAT_TARGET_PAIRS = \
+    a-intnam.ads<a-intnam-darwin.ads \
+    s-inmaop.adb<s-inmaop-posix.adb \
+    s-intman.adb<s-intman-posix.adb \
+    s-osinte.adb<s-osinte-darwin.adb \
+    s-osinte.ads<s-osinte-darwin.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-foreign.adb \
+    g-soccon.ads<g-soccon-darwin.ads \
+    a-numaux.ads<a-numaux-darwin.ads \
+    a-numaux.adb<a-numaux-darwin.adb \
+    system.ads<system-darwin-ppc.ads
+  endif
 
   TOOLS_TARGET_PAIRS =  \
     mlib-tgt-specific.adb<mlib-tgt-darwin.adb
@@ -1542,8 +1565,11 @@ LIBGNAT_OBJS = adaint.o argv.o cio.o cstreams.o ctrl_c.o errno.o exit.o env.o \
 
 include $(fsrcdir)/Makefile.rtl
 
+GNATRTL_LINEARALGEBRA_OBJS = a-nlcoar.o a-nllcar.o a-nllrar.o a-nlrear.o \
+  a-nucoar.o a-nurear.o i-forbla.o i-forlap.o s-gearop.o
+
 GNATRTL_OBJS = $(GNATRTL_NONTASKING_OBJS) $(GNATRTL_TASKING_OBJS) \
-  g-trasym.o memtrack.o
+  $(GNATRTL_LINEARALGEBRA_OBJS) g-trasym.o memtrack.o
 
 # Default run time files
 
@@ -1555,6 +1581,7 @@ ADA_INCLUDE_SRCS =\
  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
@@ -1803,6 +1830,9 @@ gnatlib: ../stamp-gnatlib1 ../stamp-gnatlib2
 	$(AR_FOR_TARGET) $(AR_FLAGS) rts/libgnarl$(arext) \
 	   $(addprefix rts/,$(GNATRTL_TASKING_OBJS))
 	$(RANLIB_FOR_TARGET) rts/libgnarl$(arext)
+	$(AR_FOR_TARGET) $(AR_FLAGS) rts/libgnala$(arext) \
+	   $(addprefix rts/,$(GNATRTL_LINEARALGEBRA_OBJS))
+	$(RANLIB_FOR_TARGET) rts/libgnala$(arext)
         ifeq ($(GMEM_LIB),gmemlib)
 		$(AR_FOR_TARGET) $(AR_FLAGS) rts/libgmem$(arext) \
 		  rts/memtrack.o

gcc/ada/a-calfor.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---            Copyright (C) 2006, Free Software Foundation, Inc.            --
+--          Copyright (C) 2006-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -140,14 +140,36 @@ package body Ada.Calendar.Formatting is
       Hour       : Hour_Number;
       Minute     : Minute_Number;
       Second     : Second_Number;
-      Sub_Second : Second_Duration;
+      Sub_Second : Duration;
       SS_Nat     : Natural;
 
-      Result : String := "00:00:00.00";
+      Low  : Integer;
+      High : Integer;
+
+      Result : String := "-00:00:00.00";
 
    begin
-      Split (Elapsed_Time, Hour, Minute, Second, Sub_Second);
-      SS_Nat := Natural (Sub_Second * 100.0);
+      Split (abs (Elapsed_Time), Hour, Minute, Second, Sub_Second);
+
+      --  Determine the two slice bounds for the result string depending on
+      --  whether the input is negative and whether fractions are requested.
+
+      if Elapsed_Time < 0.0 then
+         Low := 1;
+      else
+         Low := 2;
+      end if;
+
+      if Include_Time_Fraction then
+         High := 12;
+      else
+         High := 9;
+      end if;
+
+      --  Prevent rounding when converting to natural
+
+      Sub_Second := Sub_Second * 100.0 - 0.5;
+      SS_Nat := Natural (Sub_Second);
 
       declare
          Hour_Str   : constant String := Hour_Number'Image (Hour);
@@ -156,47 +178,45 @@ package body Ada.Calendar.Formatting is
          SS_Str     : constant String := Natural'Image (SS_Nat);
 
       begin
-         --  Hour processing, positions 1 and 2
+         --  Hour processing, positions 2 and 3
 
          if Hour < 10 then
-            Result (2) := Hour_Str (2);
+            Result (3) := Hour_Str (2);
          else
-            Result (1) := Hour_Str (2);
-            Result (2) := Hour_Str (3);
+            Result (2) := Hour_Str (2);
+            Result (3) := Hour_Str (3);
          end if;
 
-         --  Minute processing, positions 4 and 5
+         --  Minute processing, positions 5 and 6
 
          if Minute < 10 then
-            Result (5) := Minute_Str (2);
+            Result (6) := Minute_Str (2);
          else
-            Result (4) := Minute_Str (2);
-            Result (5) := Minute_Str (3);
+            Result (5) := Minute_Str (2);
+            Result (6) := Minute_Str (3);
          end if;
 
-         --  Second processing, positions 7 and 8
+         --  Second processing, positions 8 and 9
 
          if Second < 10 then
-            Result (8) := Second_Str (2);
+            Result (9) := Second_Str (2);
          else
-            Result (7) := Second_Str (2);
-            Result (8) := Second_Str (3);
+            Result (8) := Second_Str (2);
+            Result (9) := Second_Str (3);
          end if;
 
-         --  Optional sub second processing, positions 10 and 11
+         --  Optional sub second processing, positions 11 and 12
 
          if Include_Time_Fraction then
             if SS_Nat < 10 then
-               Result (11) := SS_Str (2);
+               Result (12) := SS_Str (2);
             else
-               Result (10) := SS_Str (2);
-               Result (11) := SS_Str (3);
+               Result (11) := SS_Str (2);
+               Result (12) := SS_Str (3);
             end if;
-
-            return Result;
-         else
-            return Result (1 .. 8);
          end if;
+
+         return Result (Low .. High);
       end;
    end Image;
 
@@ -215,7 +235,7 @@ package body Ada.Calendar.Formatting is
       Hour        : Hour_Number;
       Minute      : Minute_Number;
       Second      : Second_Number;
-      Sub_Second  : Second_Duration;
+      Sub_Second  : Duration;
       SS_Nat      : Natural;
       Leap_Second : Boolean;
 
@@ -225,7 +245,10 @@ package body Ada.Calendar.Formatting is
       Split (Date, Year, Month, Day,
              Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
 
-      SS_Nat := Natural (Sub_Second * 100.0);
+      --  Prevent rounding when converting to natural
+
+      Sub_Second := Sub_Second * 100.0 - 0.5;
+      SS_Nat := Natural (Sub_Second);
 
       declare
          Year_Str   : constant String := Year_Number'Image (Year);

gcc/ada/a-ngcoar.adb

@@ -65,6 +65,9 @@ package body Ada.Numerics.Generic_Complex_Arrays is
       Complex_Vector => Complex_Vector,
       Complex_Matrix => Complex_Matrix);
 
+   subtype Real is Real_Arrays.Real;
+   --  Work around visibility bug ???
+
    use BLAS, LAPACK;
 
    --  Procedure versions of functions returning unconstrained values.
@@ -1108,7 +1111,7 @@ package body Ada.Numerics.Generic_Complex_Arrays is
    -----------------
 
    procedure Eigensystem
-     (A       : in Complex_Matrix;
+     (A       : Complex_Matrix;
       Values  : out Real_Vector;
       Vectors : out Complex_Matrix)
    is

gcc/ada/a-ngcoar.ads

@@ -35,8 +35,8 @@ package Ada.Numerics.Generic_Complex_Arrays is
    function Re (X : Complex_Vector) return Real_Vector;
    function Im (X : Complex_Vector) return Real_Vector;
 
-   procedure Set_Re (X : in out Complex_Vector; Re : in Real_Vector);
-   procedure Set_Im (X : in out Complex_Vector; Im : in Real_Vector);
+   procedure Set_Re (X : in out Complex_Vector; Re : Real_Vector);
+   procedure Set_Im (X : in out Complex_Vector; Im : Real_Vector);
 
    function Compose_From_Cartesian
      (Re : Real_Vector) return Complex_Vector;
@@ -129,8 +129,8 @@ package Ada.Numerics.Generic_Complex_Arrays is
    function Re (X : Complex_Matrix) return Real_Matrix;
    function Im (X : Complex_Matrix) return Real_Matrix;
 
-   procedure Set_Re (X : in out Complex_Matrix; Re : in Real_Matrix);
-   procedure Set_Im (X : in out Complex_Matrix; Im : in Real_Matrix);
+   procedure Set_Re (X : in out Complex_Matrix; Re : Real_Matrix);
+   procedure Set_Im (X : in out Complex_Matrix; Im : Real_Matrix);
 
    function Compose_From_Cartesian (Re : Real_Matrix) return Complex_Matrix;
 
@@ -268,7 +268,7 @@ package Ada.Numerics.Generic_Complex_Arrays is
    function Eigenvalues (A : Complex_Matrix) return Real_Vector;
 
    procedure Eigensystem
-     (A       : in Complex_Matrix;
+     (A       : Complex_Matrix;
       Values  : out Real_Vector;
       Vectors : out Complex_Matrix);
 

gcc/ada/exp_ch7.adb

@@ -36,6 +36,7 @@ with Exp_Ch9;  use Exp_Ch9;
 with Exp_Ch11; use Exp_Ch11;
 with Exp_Dbug; use Exp_Dbug;
 with Exp_Dist; use Exp_Dist;
+with Exp_Disp; use Exp_Disp;
 with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
 with Freeze;   use Freeze;
@@ -310,7 +311,7 @@ package body Exp_Ch7 is
    --  Here is a simple example of the expansion of a controlled block :
 
    --    declare
-   --       X : Controlled ;
+   --       X : Controlled;
    --       Y : Controlled := Init;
    --
    --       type R is record
@@ -369,10 +370,10 @@ package body Exp_Ch7 is
    --    end;
 
    function Global_Flist_Ref (Flist_Ref : Node_Id) return Boolean;
-   --  Return True if Flist_Ref refers to a global final list, either
-   --  the object GLobal_Final_List which is used to attach standalone
-   --  objects, or any of the list controllers associated with library
-   --  level access to controlled objects
+   --  Return True if Flist_Ref refers to a global final list, either the
+   --  object Global_Final_List which is used to attach standalone objects,
+   --  or any of the list controllers associated with library-level access
+   --  to controlled objects.
 
    procedure Clean_Simple_Protected_Objects (N : Node_Id);
    --  Protected objects without entries are not controlled types, and the
@@ -1415,12 +1416,12 @@ package body Exp_Ch7 is
    --  Start of processing for Expand_Ctrl_Function_Call
 
    begin
-      --  Optimization, if the returned value (which is on the sec-stack)
-      --  is returned again, no need to copy/readjust/finalize, we can just
-      --  pass the value thru (see Expand_N_Return_Statement), and thus no
+      --  Optimization, if the returned value (which is on the sec-stack) is
+      --  returned again, no need to copy/readjust/finalize, we can just pass
+      --  the value thru (see Expand_N_Simple_Return_Statement), and thus no
       --  attachment is needed
 
-      if Nkind (Parent (N)) = N_Return_Statement then
+      if Nkind (Parent (N)) = N_Simple_Return_Statement then
          return;
       end if;
 
@@ -1579,6 +1580,13 @@ package body Exp_Ch7 is
 
       if Ekind (Ent) = E_Package then
          Push_Scope (Corresponding_Spec (N));
+
+         --  Build dispatch tables of library level tagged types
+
+         if Is_Compilation_Unit (Ent) then
+            Build_Static_Dispatch_Tables (N);
+         end if;
+
          Build_Task_Activation_Call (N);
          Pop_Scope;
       end if;
@@ -1595,23 +1603,21 @@ package body Exp_Ch7 is
    -- Expand_N_Package_Declaration --
    ----------------------------------
 
-   --  Add call to Activate_Tasks if there are tasks declared and the
-   --  package has no body. Note that in Ada83,  this may result in
-   --  premature activation of some tasks, given that we cannot tell
-   --  whether a body will eventually appear.
+   --  Add call to Activate_Tasks if there are tasks declared and the package
+   --  has no body. Note that in Ada83, this may result in premature activation
+   --  of some tasks, given that we cannot tell whether a body will eventually
+   --  appear.
 
    procedure Expand_N_Package_Declaration (N : Node_Id) is
-      Spec    : constant Node_Id := Specification (N);
+      Spec    : constant Node_Id   := Specification (N);
+      Id      : constant Entity_Id := Defining_Entity (N);
       Decls   : List_Id;
-
-      No_Body : Boolean;
+      No_Body : Boolean := False;
       --  True in the case of a package declaration that is a compilation unit
       --  and for which no associated body will be compiled in
       --  this compilation.
-   begin
-
-      No_Body := False;
 
+   begin
       --  Case of a package declaration other than a compilation unit
 
       if Nkind (Parent (N)) /= N_Compilation_Unit then
@@ -1620,7 +1626,7 @@ package body Exp_Ch7 is
       --  Case of a compilation unit that does not require a body
 
       elsif not Body_Required (Parent (N))
-        and then not Unit_Requires_Body (Defining_Entity (N))
+        and then not Unit_Requires_Body (Id)
       then
          No_Body := True;
 
@@ -1631,7 +1637,7 @@ package body Exp_Ch7 is
       --  spec).
 
       elsif Parent (N) = Cunit (Main_Unit)
-        and then Is_Remote_Call_Interface (Defining_Entity (N))
+        and then Is_Remote_Call_Interface (Id)
         and then Distribution_Stub_Mode = Generate_Caller_Stub_Body
       then
          No_Body := True;
@@ -1642,9 +1648,9 @@ package body Exp_Ch7 is
       --  have a specific separate compilation unit for that).
 
       if No_Body then
-         Push_Scope (Defining_Entity (N));
+         Push_Scope (Id);
 
-         if Has_RACW (Defining_Entity (N)) then
+         if Has_RACW (Id) then
 
             --  Generate RACW subprogram bodies
 
@@ -1659,7 +1665,7 @@ package body Exp_Ch7 is
                Set_Visible_Declarations (Spec, Decls);
             end if;
 
-            Append_RACW_Bodies (Decls, Defining_Entity (N));
+            Append_RACW_Bodies (Decls, Id);
             Analyze_List (Decls);
          end if;
 
@@ -1673,6 +1679,15 @@ package body Exp_Ch7 is
          Pop_Scope;
       end if;
 
+      --  Build dispatch tables of library level tagged types
+
+      if Is_Compilation_Unit (Id)
+        or else (Is_Generic_Instance (Id)
+                   and then Is_Library_Level_Entity (Id))
+      then
+         Build_Static_Dispatch_Tables (N);
+      end if;
+
       --  Note: it is not necessary to worry about generating a subprogram
       --  descriptor, since the only way to get exception handlers into a
       --  package spec is to include instantiations, and that would cause
@@ -1698,7 +1713,7 @@ package body Exp_Ch7 is
 
    begin
       --  Case of an internal component. The Final list is the record
-      --  controller of the enclosing record
+      --  controller of the enclosing record.
 
       if Present (Ref) then
          R := Ref;
@@ -1741,7 +1756,9 @@ package body Exp_Ch7 is
       --  context is a declaration or an assignment.
 
       elsif Is_Access_Type (E)
-        and then Ekind (E) /= E_Anonymous_Access_Type
+        and then (Ekind (E) /= E_Anonymous_Access_Type
+                    or else
+                  Present (Associated_Final_Chain (E)))
       then
          if not From_With_Type (E) then
             return
@@ -1775,15 +1792,15 @@ package body Exp_Ch7 is
             return New_Reference_To (RTE (RE_Global_Final_List), Sloc (E));
          else
             if No (Finalization_Chain_Entity (S)) then
-
-               Id := Make_Defining_Identifier (Sloc (S),
-                 New_Internal_Name ('F'));
+               Id :=
+                 Make_Defining_Identifier (Sloc (S),
+                   Chars => New_Internal_Name ('F'));
                Set_Finalization_Chain_Entity (S, Id);
 
                --  Set momentarily some semantics attributes to allow normal
                --  analysis of expansions containing references to this chain.
                --  Will be fully decorated during the expansion of the scope
-               --  itself
+               --  itself.
 
                Set_Ekind (Id, E_Variable);
                Set_Etype (Id, RTE (RE_Finalizable_Ptr));
@@ -1813,7 +1830,7 @@ package body Exp_Ch7 is
 
             --  Simple statement can be wrapped
 
-            when N_Pragma               =>
+            when N_Pragma =>
                return The_Parent;
 
             --  Usually assignments are good candidate for wrapping
@@ -1876,7 +1893,7 @@ package body Exp_Ch7 is
                  N_Terminate_Alternative            =>
                return P;
 
-            when N_Attribute_Reference              =>
+            when N_Attribute_Reference =>
 
                if Is_Procedure_Attribute_Name
                     (Attribute_Name (The_Parent))
@@ -1888,7 +1905,7 @@ package body Exp_Ch7 is
             --  expression in a raise_with_expression uses the secondary
             --  stack, for example.
 
-            when N_Raise_Statement  =>
+            when N_Raise_Statement =>
                return The_Parent;
 
             --  If the expression is within the iteration scheme of a loop,
@@ -1909,7 +1926,7 @@ package body Exp_Ch7 is
             --  The return statement is not to be wrapped when the function
             --  itself needs wrapping at the outer-level
 
-            when N_Return_Statement            =>
+            when N_Simple_Return_Statement =>
                declare
                   Applies_To : constant Entity_Id :=
                                  Return_Applies_To
@@ -3139,7 +3156,7 @@ package body Exp_Ch7 is
       if VM_Target = No_VM
         and then Uses_Sec_Stack (Current_Scope)
         and then No (Flist)
-        and then Nkind (Action) /= N_Return_Statement
+        and then Nkind (Action) /= N_Simple_Return_Statement
         and then Nkind (Par) /= N_Exception_Handler
       then
 

gcc/ada/g-socket.ads

@@ -180,13 +180,6 @@ package GNAT.Sockets is
    --           Socket_Level,
    --           (Reuse_Address, True));
 
-   --        --  Join a multicast group
-
-   --        Set_Socket_Option
-   --          (Socket,
-   --           IP_Protocol_For_IP_Level,
-   --           (Add_Membership, Inet_Addr (Group), Any_Inet_Addr));
-
    --        --  Controls the live time of the datagram to avoid it being
    --        --  looped forever due to routing errors. Routers decrement
    --        --  the TTL of every datagram as it traverses from one network
@@ -213,6 +206,16 @@ package GNAT.Sockets is
 
    --        Bind_Socket (Socket, Address);
 
+   --        --  Join a multicast group
+
+   --        --  Portability note: On Windows, this option may be set only
+   --        --  on a bound socket.
+
+   --        Set_Socket_Option
+   --          (Socket,
+   --           IP_Protocol_For_IP_Level,
+   --           (Add_Membership, Inet_Addr (Group), Any_Inet_Addr));
+
    --        --  If this socket is intended to send messages, provide the
    --        --  receiver socket address.
 
@@ -308,11 +311,6 @@ package GNAT.Sockets is
    --        Set_Socket_Option
    --          (Socket,
    --           IP_Protocol_For_IP_Level,
-   --           (Add_Membership, Inet_Addr (Group), Any_Inet_Addr));
-
-   --        Set_Socket_Option
-   --          (Socket,
-   --           IP_Protocol_For_IP_Level,
    --           (Multicast_TTL, 1));
 
    --        Set_Socket_Option
@@ -325,6 +323,11 @@ package GNAT.Sockets is
 
    --        Bind_Socket (Socket, Address);
 
+   --        Set_Socket_Option
+   --          (Socket,
+   --           IP_Protocol_For_IP_Level,
+   --           (Add_Membership, Inet_Addr (Group), Any_Inet_Addr));
+
    --        Address.Addr := Inet_Addr (Group);
    --        Address.Port := 55505;
 

gcc/ada/g-sttsne-locking.adb

@@ -31,12 +31,20 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+--  This version is used on VMS and LynxOS
+
 with GNAT.Task_Lock;
 
 with Interfaces.C; use Interfaces.C;
 
 package body GNAT.Sockets.Thin.Task_Safe_NetDB is
 
+   --  The Safe_GetXXXbyYYY routines wrap the Nonreentrant_ versions using the
+   --  task lock, and copy the relevant data structures (under the lock) into
+   --  the result. The Nonreentrant_ versions are expected to be in the parent
+   --  package GNAT.Sockets.Thin (on platforms that use this version of
+   --  Task_Safe_NetDB).
+
    procedure Copy_Host_Entry
      (Source_Hostent       : Hostent;
       Target_Hostent       : out Hostent;

gcc/ada/g-sttsne-locking.ads

@@ -31,7 +31,8 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This version is used on VMS and LynxOS
+--  This version is used on VMS, LynxOS, and VxWorks. There are two versions of
+--  the body: one for VMS and LynxOS, the other for VxWorks.
 
 package GNAT.Sockets.Thin.Task_Safe_NetDB is
 
@@ -39,12 +40,6 @@ package GNAT.Sockets.Thin.Task_Safe_NetDB is
    -- Reentrant network databases access --
    ----------------------------------------
 
-   --  The following routines wrap the Nonreentrant_ versions using the task
-   --  lock, and copy the relevant data structures (under the lock) into the
-   --  result. The Nonreentrant_ versions are expected to be in the parent
-   --  package GNAT.Sockets.Thin (on platforms that use this version of
-   --  Task_Safe_NetDB).
-
    function Safe_Gethostbyname
      (Name     : C.char_array;
       Ret      : not null access Hostent;

gcc/ada/g-sttsne-vxworks.adb

@@ -31,6 +31,9 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+--  This version is used on VxWorks. Note that the corresponding spec is in
+--  g-sttsne-locking.ads.
+
 with Interfaces.C; use Interfaces.C;
 
 package body GNAT.Sockets.Thin.Task_Safe_NetDB is

gcc/ada/g-sttsne-vxworks.ads

-------------------------------------------------------------------------------
---                                                                          --
---                         GNAT COMPILER COMPONENTS                         --
---                                                                          --
---    G N A T . S O C K E T S . T H I N . T A S K _ S A F E _ N E T D B     --
---                                                                          --
---                                 S p e c                                  --
---                                                                          --
---                     Copyright (C) 2007, 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- --
--- 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 version is used on VxWorks
-
-package GNAT.Sockets.Thin.Task_Safe_NetDB is
-
-   ----------------------------------------
-   -- Reentrant network databases access --
-   ----------------------------------------
-
-   function Safe_Gethostbyname
-     (Name     : C.char_array;
-      Ret      : not null access Hostent;
-      Buf      : System.Address;
-      Buflen   : C.int;
-      H_Errnop : not null access C.int) return C.int;
-
-   function Safe_Gethostbyaddr
-     (Addr      : System.Address;
-      Addr_Len  : C.int;
-      Addr_Type : C.int;
-      Ret       : not null access Hostent;
-      Buf       : System.Address;
-      Buflen    : C.int;
-      H_Errnop  : not null access C.int) return C.int;
-
-   function Safe_Getservbyname
-     (Name     : C.char_array;
-      Proto    : C.char_array;
-      Ret      : not null access Servent;
-      Buf      : System.Address;
-      Buflen   : C.int) return C.int;
-
-   function Safe_Getservbyport
-     (Port     : C.int;
-      Proto    : C.char_array;
-      Ret      : not null access Servent;
-      Buf      : System.Address;
-      Buflen   : C.int) return C.int;
-
-end GNAT.Sockets.Thin.Task_Safe_NetDB;

gcc/ada/g-trasym.ads

@@ -36,12 +36,13 @@
 --  This capability is currently supported on the following targets:
 
 --     HP-UX
---     Irix MIPS
+--     IRIX
 --     GNU/Linux x86
+--     AIX
 --     Solaris sparc
---     Tru64 alpha
+--     Tru64
 --     OpenVMS/Alpha
---     Windows NT/XP
+--     Windows NT/XP/Vista
 
 --  The routines provided in this package assume that your application has
 --  been compiled with debugging information turned on, since this information
@@ -59,16 +60,15 @@
 --  - archive this executable
 --  - strip a copy of the executable and distribute/deploy this version
 --  - at run time, compute absolute traceback (-bargs -E) from your
---    executable and log it using Ada.Exceptions.Exception_Occurrence
+--    executable and log it using Ada.Exceptions.Exception_Information
 --  - off line, compute the symbolic traceback using the executable archived
 --    with debug info and addr2line or gdb (using info line *<addr>) on the
 --    absolute addresses logged by your application.
 
 --  In order to retrieve symbolic information, functions in this package will
 --  read on disk all the debug information of the executable file (found via
---  Argument (0), so any path information needed to read the executable file
---  need to be provided when launching the executable), and load then in
---  memory, causing a significant cpu and memory overhead.
+--  Argument (0), and looked in the PATH if needed), and load them in memory,
+--  causing a significant cpu and memory overhead.
 
 --  On all platforms except VMS, this package is not intended to be used
 --  within a shared library, symbolic tracebacks are only supported for the

gcc/ada/gen-soccon.c

@@ -497,6 +497,11 @@ CND(TCP_NODELAY, "Do not coalesce packets")
 #endif
 CND(SO_REUSEADDR, "Bind reuse local address")
 
+#ifndef SO_REUSEPORT
+#define SO_REUSEPORT -1
+#endif
+CND(SO_REUSEPORT, "Bind reuse port number")
+
 #ifndef SO_KEEPALIVE
 #define SO_KEEPALIVE -1
 #endif

gcc/ada/gnatchop.adb

@@ -38,12 +38,10 @@ with GNAT.Table;
 
 with Gnatvsn;
 with Hostparm;
+with Types;
 
 procedure Gnatchop is
 
-   Terminate_Program : exception;
-   --  Used to terminate execution immediately
-
    Config_File_Name : constant String_Access := new String'("gnat.adc");
    --  The name of the file holding the GNAT configuration pragmas
 
@@ -362,7 +360,7 @@ procedure Gnatchop is
          Set_Exit_Status (Failure);
 
          if Exit_On_Error then
-            raise Terminate_Program;
+            raise Types.Terminate_Program;
          end if;
       end if;
    end Error_Msg;
@@ -696,7 +694,7 @@ procedure Gnatchop is
       return Success;
 
    exception
-      when Failure | Terminate_Program =>
+      when Failure | Types.Terminate_Program =>
          Close (Offset_FD);
          Delete_File (Offset_Name'Address, Success);
          return False;
@@ -1114,7 +1112,7 @@ procedure Gnatchop is
 
             when 'h' =>
                Usage;
-               raise Terminate_Program;
+               raise Types.Terminate_Program;
 
             when 'k' =>
                declare
@@ -1852,7 +1850,7 @@ begin
    return;
 
 exception
-   when Terminate_Program =>
+   when Types.Terminate_Program =>
       null;
 
 end Gnatchop;

gcc/ada/gnatvsn.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---       Copyright (C) 2002-2006 Free Software Foundation, Inc.             --
+--       Copyright (C) 2002-2007 Free Software Foundation, Inc.             --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -33,6 +33,19 @@
 
 package body Gnatvsn is
 
+   ------------------------
+   -- Gnat_Free_Software --
+   ------------------------
+
+   function Gnat_Free_Software return String is
+   begin
+      return
+        "This is free software; see the source for copying conditions." &
+        ASCII.LF &
+        "There is NO warranty; not even for MERCHANTABILITY or FITNESS" &
+        " FOR A PARTICULAR PURPOSE.";
+   end Gnat_Free_Software;
+
    Version_String : String (1 .. Ver_Len_Max);
    --  Import the C string defined in the (language-independent) source file
    --  version.c.

gcc/ada/gnatvsn.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2006 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2007 Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -64,6 +64,10 @@ package Gnatvsn is
    --       gives appropriate bug submission instructions that do not reference
    --       customer number etc.
 
+   function Gnat_Free_Software return String;
+   --  Text to be displayed by the different GNAT tools when switch --version
+   --  is used. This text depends on the GNAT build type.
+
    Ver_Len_Max : constant := 64;
    --  Longest possible length for Gnat_Version_String in this or any
    --  other version of GNAT. This is used by the binder to establish
@@ -89,7 +93,14 @@ package Gnatvsn is
    --  the tree format that would result in a compiler being incompatible with
    --  an older version of ASIS, or vice versa.
 
-   Current_Year : constant String := "2006";
+   PCS_Version_Number : constant := 1;
+   --  PCS interface version. This is used to check for consistency between the
+   --  compiler used to generate distribution stubs and the PCS implementation.
+   --  It must be incremented whenever a change is made to the generated code
+   --  for distribution stubs that would result in the compiler being
+   --  incompatible with an older version of the PCS, or vice versa.
+
+   Current_Year : constant String := "2007";
    --  Used in printing copyright messages
 
 end Gnatvsn;

gcc/ada/i-forbla.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---            Copyright (C) 2006, Free Software Foundation, Inc.            --
+--         Copyright (C) 2006-2007, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -31,9 +31,13 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  For platforms without, or with unknown libraries, no libraries are linked
---  by default. The user has to specify the required BLAS and LAPACK libraries
---  explicitly on the command line.
+--  This Interfaces.Fortran.Blas package body contains the required linker
+--  pragmas for automatically linking with the gnalasup linear algebra support
+--  library, and the systems math library. Alternative bodies can be supplied
+--  if different sets of libraries are needed.
 
 package body Interfaces.Fortran.BLAS is
+   pragma Linker_Options ("-lgnala");
+   pragma Linker_Options ("-lgnalasup");
+   pragma Linker_Options ("-lm");
 end Interfaces.Fortran.BLAS;

gcc/ada/i-forbla.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---            Copyright (C) 2006, Free Software Foundation, Inc.            --
+--         Copyright (C) 2006-2007, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -31,10 +31,22 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  Comment required if non-RM package ???
+--  This package provides a thin binding to the standard Fortran BLAS library.
+--  Documentation and a reference BLAS implementation is available from
+--  ftp://ftp.netlib.org. The main purpose of this package is to facilitate
+--  implementation of the Ada 2005 Ada.Numerics.Generic_Real_Arrays and
+--  Ada.Numerics.Generic_Complex_Arrays packages. Bindings to other BLAS
+--  routines may be added over time.
+
+--  As actual linker arguments to link with the BLAS implementation differs
+--  according to platform and chosen BLAS implementation, the linker arguments
+--  are given in the body of this package. The body may need to be modified in
+--  order to link with different BLAS implementations tuned to the specific
+--  target.
 
 package Interfaces.Fortran.BLAS is
    pragma Pure;
+   pragma Elaborate_Body;
 
    No_Trans   : aliased constant Character := 'N';
    Trans      : aliased constant Character := 'T';
@@ -81,14 +93,14 @@ package Interfaces.Fortran.BLAS is
       Y     : Double_Precision_Vector;
       Inc_Y : Integer := 1) return Double_Precision;
 
-   function cdot
+   function cdotu
      (N     : Positive;
       X     : Complex_Vector;
       Inc_X : Integer := 1;
       Y     : Complex_Vector;
       Inc_Y : Integer := 1) return Complex;
 
-   function zdot
+   function zdotu
      (N     : Positive;
       X     : Double_Complex_Vector;
       Inc_X : Integer := 1;
@@ -232,7 +244,7 @@ package Interfaces.Fortran.BLAS is
       Ld_C    : Integer);
 
 private
-   pragma Import (Fortran, cdot,   "cdot_");
+   pragma Import (Fortran, cdotu,  "cdotu_");
    pragma Import (Fortran, cgemm,  "cgemm_");
    pragma Import (Fortran, cgemv,  "cgemv_");
    pragma Import (Fortran, ddot,   "ddot_");
@@ -245,7 +257,7 @@ private
    pragma Import (Fortran, sgemm,  "sgemm_");
    pragma Import (Fortran, sgemv,  "sgemv_");
    pragma Import (Fortran, snrm2,  "snrm2_");
-   pragma Import (Fortran, zdot,   "zdot_");
+   pragma Import (Fortran, zdotu,  "zdotu_");
    pragma Import (Fortran, zgemm,  "zgemm_");
    pragma Import (Fortran, zgemv,  "zgemv_");
 end Interfaces.Fortran.BLAS;

gcc/ada/i-forlap.ads

@@ -293,7 +293,7 @@ package Interfaces.Fortran.LAPACK is
       N      : Natural;
       A      : in out Real_Matrix;
       Ld_A   : Positive;
-      Tau    : in Real_Vector;
+      Tau    : Real_Vector;
       Work   : out Real_Vector;
       L_Work : Integer;
       Info   : access Integer);
@@ -303,7 +303,7 @@ package Interfaces.Fortran.LAPACK is
       N      : Natural;
       A      : in out Double_Precision_Matrix;
       Ld_A   : Positive;
-      Tau    : in Double_Precision_Vector;
+      Tau    : Double_Precision_Vector;
       Work   : out Double_Precision_Vector;
       L_Work : Integer;
       Info   : access Integer);
@@ -311,12 +311,12 @@ package Interfaces.Fortran.LAPACK is
    procedure sstebz
      (Rng      : access constant Character;
       Order    : access constant Character;
-      N        : in Natural;
-      Vl, Vu   : in Real := 0.0;
-      Il, Iu   : in Integer := 1;
-      Abs_Tol  : in Real := 0.0;
-      D        : in Real_Vector;
-      E        : in Real_Vector;
+      N        : Natural;
+      Vl, Vu   : Real := 0.0;
+      Il, Iu   : Integer := 1;
+      Abs_Tol  : Real := 0.0;
+      D        : Real_Vector;
+      E        : Real_Vector;
       M        : out Natural;
       N_Split  : out Natural;
       W        : out Real_Vector;
@@ -329,12 +329,12 @@ package Interfaces.Fortran.LAPACK is
    procedure dstebz
      (Rng      : access constant Character;
       Order    : access constant Character;
-      N        : in Natural;
-      Vl, Vu   : in Double_Precision := 0.0;
-      Il, Iu   : in Integer := 1;
-      Abs_Tol  : in Double_Precision := 0.0;
-      D        : in Double_Precision_Vector;
-      E        : in Double_Precision_Vector;
+      N        : Natural;
+      Vl, Vu   : Double_Precision := 0.0;
+      Il, Iu   : Integer := 1;
+      Abs_Tol  : Double_Precision := 0.0;
+      D        : Double_Precision_Vector;
+      E        : Double_Precision_Vector;
       M        : out Natural;
       N_Split  : out Natural;
       W        : out Double_Precision_Vector;

gcc/ada/lib-load.adb

@@ -52,7 +52,7 @@ package body Lib.Load is
    -- Local Subprograms --
    -----------------------
 
-   function From_Limited_With_Chain (Lim : Boolean) return Boolean;
+   function From_Limited_With_Chain 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.
@@ -236,22 +236,24 @@ package body Lib.Load is
    -- From_Limited_With_Chain --
    -----------------------------
 
-   function From_Limited_With_Chain (Lim : Boolean) return Boolean is
+   function From_Limited_With_Chain return Boolean is
+      Curr_Num : constant Unit_Number_Type :=
+                   Load_Stack.Table (Load_Stack.Last).Unit_Number;
+
    begin
       --  True if the current load operation is through a limited_with clause
+      --  and we are not within a loop of regular with_clauses.
 
-      if Lim then
-         return True;
-
-      --  Examine the Load_Stack to locate any previous Limited_with clause
+      for U in reverse Load_Stack.First .. Load_Stack.Last - 1 loop
+         if Load_Stack.Table (U).Unit_Number = Curr_Num then
+            return False;
 
-      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;
+         elsif Present (Load_Stack.Table (U).With_Node)
+           and then Limited_Present (Load_Stack.Table (U).With_Node)
+         then
+            return True;
+         end if;
+      end loop;
 
       return False;
    end From_Limited_With_Chain;
@@ -285,7 +287,7 @@ package body Lib.Load is
 
    begin
       Load_Stack.Increment_Last;
-      Load_Stack.Table (Load_Stack.Last) := (Main_Unit, False);
+      Load_Stack.Table (Load_Stack.Last) := (Main_Unit, Empty);
 
       --  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
@@ -339,7 +341,7 @@ package body Lib.Load is
       Subunit           : Boolean;
       Corr_Body         : Unit_Number_Type := No_Unit;
       Renamings         : Boolean          := False;
-      From_Limited_With : Boolean          := False) return Unit_Number_Type
+      With_Node         : Node_Id          := Empty) return Unit_Number_Type
    is
       Calling_Unit : Unit_Number_Type;
       Uname_Actual : Unit_Name_Type;
@@ -558,7 +560,7 @@ package body Lib.Load is
       --  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);
+      Load_Stack.Table (Load_Stack.Last) := (Unum, With_Node);
 
       --  Case of entry already in table
 
@@ -579,7 +581,7 @@ package body Lib.Load is
                        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)
+           and then not From_Limited_With_Chain
          then
             if Debug_Flag_L then
                Write_Str ("  circular dependency encountered");
@@ -653,8 +655,7 @@ package body Lib.Load is
                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));
+               Discard_List (Par (Configuration_Pragmas => False));
                Multiple_Unit_Index := Save_Index;
                Set_Loading (Unum, False);
             end;

gcc/ada/lib-load.ads

@@ -110,7 +110,7 @@ package Lib.Load is
       Subunit           : Boolean;
       Corr_Body         : Unit_Number_Type := No_Unit;
       Renamings         : Boolean          := False;
-      From_Limited_With : Boolean          := False) return Unit_Number_Type;
+      With_Node         : Node_Id          := Empty) 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

gcc/ada/link.c

@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2004, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2007, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -154,13 +154,13 @@ unsigned char __gnat_using_gnu_linker = 0;
 const char *__gnat_object_library_extension = ".a";
 
 #elif defined (__FreeBSD__)
-char *__gnat_object_file_option = "";
-char *__gnat_run_path_option = "-Wl,-rpath,";
+const char *__gnat_object_file_option = "";
+const char *__gnat_run_path_option = "-Wl,-rpath,";
 char __gnat_shared_libgnat_default = STATIC;
 int __gnat_link_max = 8192;
 unsigned char __gnat_objlist_file_supported = 1;
 unsigned char __gnat_using_gnu_linker = 1;
-char *__gnat_object_library_extension = ".a";
+const char *__gnat_object_library_extension = ".a";
 
 #elif defined (linux)
 const char *__gnat_object_file_option = "";

gcc/ada/mdll-fil.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -80,11 +80,12 @@ package body MDLL.Fil is
    begin
       if I = 0 then
          return Filename;
+
       else
          if New_Ext = "" then
-            return Head (Filename, I - 1);
+            return Filename (Filename'First .. I - 1);
          else
-            return Head (Filename, I - 1) & '.' & New_Ext;
+            return Filename (Filename'First .. I - 1) & '.' & New_Ext;
          end if;
       end if;
    end Ext_To;

gcc/ada/mdll.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -25,7 +25,7 @@
 ------------------------------------------------------------------------------
 
 --  This package provides the core high level routines used by GNATDLL
---  to build Windows DLL
+--  to build Windows DLL.
 
 with Ada.Text_IO;
 
@@ -38,6 +38,10 @@ package body MDLL is
    use Ada;
    use GNAT;
 
+   --  Convention used for the library names on Windows:
+   --  DLL:            <name>.dll
+   --  Import library: lib<name>.dll
+
    function Get_Dll_Name (Lib_Filename : String) return String;
    --  Returns <Lib_Filename> if it contains a file extension otherwise it
    --  returns <Lib_Filename>.dll.
@@ -69,7 +73,7 @@ package body MDLL is
       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";
+      Lib_File : aliased constant String := "lib" & Base_Filename & ".dll.a";
 
       Bas_Opt  : aliased String := "-Wl,--base-file," & Bas_File;
       Lib_Opt  : aliased String := "-mdll";
@@ -450,10 +454,32 @@ package body MDLL is
       --------------------------
 
       procedure Build_Import_Library (Lib_Filename : String) is
+
+         function No_Lib_Prefix (Filename : String) return String;
+         --  Return Filename without the lib prefix if present
+
+         -------------------
+         -- No_Lib_Prefix --
+         -------------------
+
+         function No_Lib_Prefix (Filename : String) return String is
+         begin
+            if Filename (Filename'First .. Filename'First + 2) = "lib" then
+               return Filename (Filename'First + 3 .. Filename'Last);
+            else
+               return Filename;
+            end if;
+         end No_Lib_Prefix;
+
+         --  Local variables
+
          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";
+         Base_Filename : constant String :=
+                           MDLL.Fil.Ext_To (No_Lib_Prefix (Lib_Filename));
+         Lib_File      : constant String := "lib" & Base_Filename & ".dll.a";
+
+      --  Start of processing for Build_Import_Library
 
       begin
          if not Quiet then
@@ -469,20 +495,7 @@ package body MDLL is
    --  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 (Lib_Filename'First .. Lib_Filename'First + 2) = "lib"
-      then
-         Build_Import_Library
-           (Lib_Filename (Lib_Filename'First + 3 .. Lib_Filename'Last));
-      else
-         Build_Import_Library (Lib_Filename);
-      end if;
+      Build_Import_Library (Lib_Filename);
    end Build_Import_Library;
 
    ------------------

gcc/ada/mlib-utl.adb

@@ -36,7 +36,7 @@ with System;
 
 package body MLib.Utl is
 
-   Gcc_Name : constant String := Osint.Program_Name ("gcc").all;
+   Gcc_Name : String_Access;
    --  Default value of the "gcc" executable used in procedure Gcc
 
    Gcc_Exec : String_Access;
@@ -408,10 +408,14 @@ package body MLib.Utl is
    begin
       if Driver_Name = No_Name then
          if Gcc_Exec = null then
-            Gcc_Exec := Locate_Exec_On_Path (Gcc_Name);
+            if Gcc_Name = null then
+               Gcc_Name :=  Osint.Program_Name ("gcc");
+            end if;
+
+            Gcc_Exec := Locate_Exec_On_Path (Gcc_Name.all);
 
             if Gcc_Exec = null then
-               Fail (Gcc_Name, " not found in path");
+               Fail (Gcc_Name.all, " not found in path");
             end if;
          end if;
 
@@ -579,7 +583,7 @@ package body MLib.Utl is
 
       if not Success then
          if Driver_Name = No_Name then
-            Fail (Gcc_Name, " execution error");
+            Fail (Gcc_Name.all, " execution error");
          else
             Fail (Get_Name_String (Driver_Name), " execution error");
          end if;

gcc/ada/osint.adb

@@ -857,8 +857,7 @@ package body Osint is
       --  If we come here, the user has typed the executable name with no
       --  directory prefix.
 
-      return Get_Install_Dir
-        (System.OS_Lib.Locate_Exec_On_Path (Exec_Name.all).all);
+      return Get_Install_Dir (Locate_Exec_On_Path (Exec_Name.all).all);
    end Executable_Prefix;
 
    ------------------
@@ -1055,6 +1054,11 @@ package body Osint is
    begin
       Fill_Arg (Command_Name'Address, 0);
 
+      if Command_Name = "" then
+         Name_Len := 0;
+         return;
+      end if;
+
       --  The program name might be specified by a full path name. However,
       --  we don't want to print that all out in an error message, so the
       --  path might need to be stripped away.
@@ -1824,6 +1828,16 @@ package body Osint is
       return Name_Enter;
    end Object_File_Name;
 
+   -------------------------------
+   -- OS_Exit_Through_Exception --
+   -------------------------------
+
+   procedure OS_Exit_Through_Exception (Status : Integer) is
+   begin
+      Current_Exit_Status := Status;
+      raise Types.Terminate_Program;
+   end OS_Exit_Through_Exception;
+
    --------------------------
    -- OS_Time_To_GNAT_Time --
    --------------------------

gcc/ada/osint.ads

@@ -520,6 +520,14 @@ package Osint is
    -- Termination --
    -----------------
 
+   Current_Exit_Status : Integer := 0;
+   --  Exit status that is set with procedure OS_Exit_Through_Exception below
+   --  and can be used in exception handler for Types.Terminate_Program to call
+   --  Set_Exit_Status as the last action of the program.
+
+   procedure OS_Exit_Through_Exception (Status : Integer);
+   --  Set the Current_Exit_Status, then raise Types.Terminate_Program
+
    type Exit_Code_Type is (
       E_Success,    -- No warnings or errors
       E_Warnings,   -- Compiler warnings generated

gcc/ada/par-load.adb

@@ -322,11 +322,10 @@ begin
       if Spec_Name /= No_Unit_Name then
          Unum :=
            Load_Unit
-             (Load_Name         => Spec_Name,
-              Required          => True,
-              Subunit           => False,
-              Error_Node        => Curunit,
-              From_Limited_With => From_Limited_With);
+             (Load_Name  => Spec_Name,
+              Required   => True,
+              Subunit    => False,
+              Error_Node => Curunit);
 
          if Unum /= No_Unit then
             Set_Parent_Spec (Unit (Curunit), Cunit (Unum));
@@ -389,14 +388,12 @@ begin
 
             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));
+                (Load_Name  => Spec_Name,
+                 Required   => False,
+                 Subunit    => False,
+                 Error_Node => With_Node,
+                 Renamings  => True,
+                 With_Node  => 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

gcc/ada/rtsfind.adb

@@ -33,6 +33,7 @@ with Elists;   use Elists;
 with Errout;   use Errout;
 with Fname;    use Fname;
 with Fname.UF; use Fname.UF;
+with Gnatvsn;  use Gnatvsn;
 with Lib;      use Lib;
 with Lib.Load; use Lib.Load;
 with Namet;    use Namet;
@@ -862,9 +863,10 @@ package body Rtsfind is
 
       procedure Check_RPC;
       --  Reject programs that make use of distribution features not supported
-      --  on the current target. On such targets (VMS, Vxworks, others?) we
-      --  only provide a minimal body for System.Rpc that only supplies an
-      --  implementation of partition_id.
+      --  on the current target. Also check that the PCS is compatible with
+      --  the code generator version. On such targets (VMS, Vxworks, others?)
+      --  we provide a minimal body for System.Rpc that only supplies an
+      --  implementation of Partition_Id.
 
       function Find_Local_Entity (E : RE_Id) return Entity_Id;
       --  This function is used when entity E is in this compilation's main
@@ -875,6 +877,25 @@ package body Rtsfind is
       ---------------
 
       procedure Check_RPC is
+
+         procedure Check_RPC_Failure (Msg : String);
+         pragma No_Return (Check_RPC_Failure);
+         --  Display Msg on standard error and raise Unrecoverable_Error
+
+         -----------------------
+         -- Check_RPC_Failure --
+         -----------------------
+
+         procedure Check_RPC_Failure (Msg : String) is
+         begin
+            Set_Standard_Error;
+            Write_Str (Msg);
+            Write_Eol;
+            raise Unrecoverable_Error;
+         end Check_RPC_Failure;
+
+      --  Start of processing for Check_RPC
+
       begin
          --  Bypass this check if debug flag -gnatdR set
 
@@ -897,12 +918,14 @@ package body Rtsfind is
                      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;
+            if Get_PCS_Name = Name_No_DSA then
+               Check_RPC_Failure ("distribution feature not supported");
+
+            elsif Get_PCS_Version /= Gnatvsn.PCS_Version_Number then
+               Check_RPC_Failure ("PCS version mismatch");
+
+            end if;
          end if;
       end Check_RPC;
 

gcc/ada/s-gearop.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---            Copyright (C) 2006, Free Software Foundation, Inc.            --
+--         Copyright (C) 2006-2007, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -151,7 +151,12 @@ package body System.Generic_Array_Operations is
 
       for J in R'Range (1) loop
          for K in R'Range (2) loop
-            R (J, K) := Operation (Left (J, K), Right (J, K));
+            R (J, K) :=
+              Operation
+                (Left (J, K),
+                 Right
+                   (J - R'First (1) + Right'First (1),
+                    K - R'First (2) + Right'First (2)));
          end loop;
       end loop;
 
@@ -179,7 +184,12 @@ package body System.Generic_Array_Operations is
 
       for J in R'Range (1) loop
          for K in R'Range (2) loop
-            R (J, K) := Operation (X (J, K), Y (J, K), Z);
+            R (J, K) :=
+              Operation
+                (X (J, K),
+                 Y (J - R'First (1) + Y'First (1),
+                    K - R'First (2) + Y'First (2)),
+                 Z);
          end loop;
       end loop;
 
@@ -203,7 +213,7 @@ package body System.Generic_Array_Operations is
       end if;
 
       for J in R'Range loop
-         R (J) := Operation (Left (J), Right (J));
+         R (J) := Operation (Left (J), Right (J - R'First + Right'First));
       end loop;
 
       return R;
@@ -227,7 +237,7 @@ package body System.Generic_Array_Operations is
       end if;
 
       for J in R'Range loop
-         R (J) := Operation (X (J), Y (J), Z);
+         R (J) := Operation (X (J), Y (J - X'First + Y'First), Z);
       end loop;
 
       return R;
@@ -402,8 +412,8 @@ package body System.Generic_Array_Operations is
    begin
       for J in R'Range (1) loop
          for K in R'Range (2) loop
-            R (J, K) := A (J - R'First (1) + A'First (1),
-                           K - R'First (2) + A'First (2));
+            R (J, K) := A (K - R'First (2) + A'First (1),
+                           J - R'First (1) + A'First (2));
          end loop;
       end loop;
    end Transpose;

gcc/ada/s-gecobl.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---            Copyright (C) 2006, Free Software Foundation, Inc.            --
+--         Copyright (C) 2006-2007, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -146,7 +146,7 @@ package body System.Generic_Complex_BLAS is
             function Conv_X is new Unchecked_Conversion (Address, X_Ptr);
             function Conv_Y is new Unchecked_Conversion (Address, Y_Ptr);
          begin
-            return To_Complex (BLAS.cdot (N, Conv_X (X'Address).all, Inc_X,
+            return To_Complex (BLAS.cdotu (N, Conv_X (X'Address).all, Inc_X,
                                   Conv_Y (Y'Address).all, Inc_Y));
          end;
 
@@ -157,12 +157,12 @@ package body System.Generic_Complex_BLAS is
             function Conv_X is new Unchecked_Conversion (Address, X_Ptr);
             function Conv_Y is new Unchecked_Conversion (Address, Y_Ptr);
          begin
-            return To_Complex (BLAS.zdot (N, Conv_X (X'Address).all, Inc_X,
+            return To_Complex (BLAS.zdotu (N, Conv_X (X'Address).all, Inc_X,
                                      Conv_Y (Y'Address).all, Inc_Y));
          end;
 
       else
-         return To_Complex (BLAS.zdot (N, To_Double_Complex (X), Inc_X,
+         return To_Complex (BLAS.zdotu (N, To_Double_Complex (X), Inc_X,
                                   To_Double_Complex (Y), Inc_Y));
       end if;
    end dot;
@@ -177,7 +177,7 @@ package body System.Generic_Complex_BLAS is
       M       : Positive;
       N       : Positive;
       K       : Positive;
-      Alpha   : Complex := (1.0, 1.0);
+      Alpha   : Complex := (1.0, 0.0);
       A       : Complex_Matrix;
       Ld_A    : Integer;
       B       : Complex_Matrix;
@@ -251,7 +251,7 @@ package body System.Generic_Complex_BLAS is
      (Trans : access constant Character;
       M     : Natural := 0;
       N     : Natural := 0;
-      Alpha : Complex := (1.0, 1.0);
+      Alpha : Complex := (1.0, 0.0);
       A     : Complex_Matrix;
       Ld_A  : Positive;
       X     : Complex_Vector;

gcc/ada/s-gecobl.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---            Copyright (C) 2006, Free Software Foundation, Inc.            --
+--         Copyright (C) 2006-2007, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -73,7 +73,7 @@ package System.Generic_Complex_BLAS is
      (Trans : access constant Character;
       M     : Natural := 0;
       N     : Natural := 0;
-      Alpha : Complex := (1.0, 1.0);
+      Alpha : Complex := (1.0, 0.0);
       A     : Complex_Matrix;
       Ld_A  : Positive;
       X     : Complex_Vector;
@@ -92,7 +92,7 @@ package System.Generic_Complex_BLAS is
       M       : Positive;
       N       : Positive;
       K       : Positive;
-      Alpha   : Complex := (1.0, 1.0);
+      Alpha   : Complex := (1.0, 0.0);
       A       : Complex_Matrix;
       Ld_A    : Integer;
       B       : Complex_Matrix;

gcc/ada/s-gerela.adb

@@ -282,7 +282,7 @@ package body System.Generic_Real_LAPACK is
       N      : Natural;
       A      : in out Real_Matrix;
       Ld_A   : Positive;
-      Tau    : in Real_Vector;
+      Tau    : Real_Vector;
       Work   : out Real_Vector;
       L_Work : Integer;
       Info   : access Integer)

gcc/ada/s-gerela.ads

@@ -94,7 +94,7 @@ package System.Generic_Real_LAPACK is
       N      : Natural;
       A      : in out Real_Matrix;
       Ld_A   : Positive;
-      Tau    : in Real_Vector;
+      Tau    : Real_Vector;
       Work   : out Real_Vector;
       L_Work : Integer;
       Info   : access Integer);

gcc/ada/s-os_lib.adb

@@ -1698,18 +1698,13 @@ package body System.OS_Lib is
       Canonical_File_Addr : System.Address;
       Canonical_File_Len  : Integer;
 
-      Need_To_Check_Drive_Letter : Boolean := False;
-      --  Set to true if Name is an absolute path that starts with "//"
-
       function Strlen (S : System.Address) return Integer;
       pragma Import (C, Strlen, "strlen");
 
       function Final_Value (S : String) return String;
-      --  Make final adjustment to the returned string.
-      --  To compensate for non standard path name in Interix,
-      --  if S is "/x" or starts with "/x", where x is a capital
-      --  letter 'A' to 'Z', add an additional '/' at the beginning
-      --  so that the returned value starts with "//x".
+      --  Make final adjustment to the returned string. This function strips
+      --  trailing directory separators, and folds returned string to lower
+      --  case if required.
 
       function Get_Directory  (Dir : String) return String;
       --  If Dir is not empty, return it, adding a directory separator
@@ -1727,71 +1722,33 @@ package body System.OS_Lib is
          Last : Natural;
 
       begin
-         --  Interix has the non standard notion of disk drive
-         --  indicated by two '/' followed by a capital letter
-         --  'A' .. 'Z'. One of the two '/' may have been removed
-         --  by Normalize_Pathname. It has to be added again.
-         --  For other OSes, this should not make no difference.
-
-         if Need_To_Check_Drive_Letter
-           and then S'Length >= 2
-           and then S (S'First) = '/'
-           and then S (S'First + 1) in 'A' .. 'Z'
-           and then (S'Length = 2 or else S (S'First + 2) = '/')
-         then
-            declare
-               Result : String (1 .. S'Length + 1);
-
-            begin
-               Result (1) := '/';
-               Result (2 .. Result'Last) := S;
-               Last := Result'Last;
-
-               if Fold_To_Lower_Case then
-                  System.Case_Util.To_Lower (Result);
-               end if;
-
-               --  Remove trailing directory separator, if any
-
-               if Last > 1 and then
-                 (Result (Last) = '/' or else
-                  Result (Last) = Directory_Separator)
-               then
-                  Last := Last - 1;
-               end if;
+         if Fold_To_Lower_Case then
+            System.Case_Util.To_Lower (S1);
+         end if;
 
-               return Result (1 .. Last);
-            end;
+         --  Remove trailing directory separator, if any
 
-         else
-            if Fold_To_Lower_Case then
-               System.Case_Util.To_Lower (S1);
-            end if;
+         Last := S1'Last;
 
-            --  Remove trailing directory separator, if any
-
-            Last := S1'Last;
+         if Last > 1
+           and then (S1 (Last) = '/'
+                       or else
+                     S1 (Last) = Directory_Separator)
+         then
+            --  Special case for Windows: C:\
 
-            if Last > 1
-              and then (S1 (Last) = '/'
-                          or else
-                        S1 (Last) = Directory_Separator)
+            if Last = 3
+              and then S1 (1) /= Directory_Separator
+              and then S1 (2) = ':'
             then
-               --  Special case for Windows: C:\
-
-               if Last = 3
-                 and then S1 (1) /= Directory_Separator
-                 and then S1 (2) = ':'
-               then
-                  null;
+               null;
 
-               else
-                  Last := Last - 1;
-               end if;
+            else
+               Last := Last - 1;
             end if;
-
-            return S1 (1 .. Last);
          end if;
+
+         return S1 (1 .. Last);
       end Final_Value;
 
       -------------------
@@ -1956,12 +1913,6 @@ package body System.OS_Lib is
             Last := Reference_Dir'Length;
          end if;
 
-         --  If name starts with "//", we may have a drive letter on Interix
-
-         if Last = 1 and then End_Path >= 3 then
-            Need_To_Check_Drive_Letter := (Path_Buffer (1 .. 2)) = "//";
-         end if;
-
          Start  := Last + 1;
          Finish := Last;
 
@@ -2167,6 +2118,28 @@ package body System.OS_Lib is
       return Open_Read_Write (C_Name (C_Name'First)'Address, Fmode);
    end Open_Read_Write;
 
+   -------------
+   -- OS_Exit --
+   -------------
+
+   procedure OS_Exit (Status : Integer) is
+   begin
+      OS_Exit_Ptr (Status);
+      raise Program_Error;
+   end OS_Exit;
+
+   ---------------------
+   -- OS_Exit_Default --
+   ---------------------
+
+   procedure OS_Exit_Default (Status : Integer) is
+      procedure GNAT_OS_Exit (Status : Integer);
+      pragma Import (C, GNAT_OS_Exit, "__gnat_os_exit");
+      pragma No_Return (GNAT_OS_Exit);
+   begin
+      GNAT_OS_Exit (Status);
+   end OS_Exit_Default;
+
    --------------------
    -- Pid_To_Integer --
    --------------------

gcc/ada/s-os_lib.ads

@@ -814,12 +814,24 @@ package System.OS_Lib is
    --  changes made by Setenv calls. This procedure is not available on VMS.
 
    procedure OS_Exit (Status : Integer);
-   pragma Import (C, OS_Exit, "__gnat_os_exit");
    pragma No_Return (OS_Exit);
+
    --  Exit to OS with given status code (program is terminated). Note that
    --  this is abrupt termination. All tasks are immediately terminated. There
    --  are no finalization or other Ada-specific cleanup actions performed. On
-   --  systems with atexit handlers (such as Unix and Windows) are performed.
+   --  systems with atexit handlers (such as Unix and Windows), atexit handlers
+   --  are called.
+
+   type OS_Exit_Subprogram is access procedure (Status : Integer);
+
+   procedure OS_Exit_Default (Status : Integer);
+   pragma No_Return (OS_Exit_Default);
+   --  Default implementation of procedure OS_Exit
+
+   OS_Exit_Ptr : OS_Exit_Subprogram := OS_Exit_Default'Access;
+   --  OS_Exit is implemented through this access value. It it then possible to
+   --  change the implementation of OS_Exit by redirecting OS_Exit_Ptr to an
+   --  other implementation.
 
    procedure OS_Abort;
    pragma Import (C, OS_Abort, "abort");

gcc/ada/s-parint.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1995-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -45,6 +45,12 @@ package System.Partition_Interface is
 
    type DSA_Implementation_Name is (No_DSA, GARLIC_DSA, PolyORB_DSA);
    DSA_Implementation : constant DSA_Implementation_Name := No_DSA;
+   --  Identification of this DSA implementation variant
+
+   PCS_Version : constant := 1;
+   --  Version of the PCS API (for Exp_Dist consistency check).
+   --  This version number is matched against Gnatvsn.PCS_Version_Number to
+   --  ensure that the versions of Exp_Dist and the PCS are consistent.
 
    --  RCI receiving stubs contain a table of descriptors for
    --  all user subprograms exported by the unit.

gcc/ada/sem_ch7.adb

@@ -1100,7 +1100,10 @@ package body Sem_Ch7 is
 
          --  The current compilation unit may include private with_clauses,
          --  which are visible in the private part of the current nested
-         --  package, and have to be installed now.
+         --  package, and have to be installed now. This is not done for
+         --  nested instantiations, where the private with_clauses of the
+         --  enclosing unit have no effect once the instantiation info is
+         --  established and we start analyzing the package declaration.
 
          declare
             Comp_Unit : constant Entity_Id := Cunit_Entity (Current_Sem_Unit);
@@ -1108,6 +1111,7 @@ package body Sem_Ch7 is
             if (Ekind (Comp_Unit) = E_Package
                  or else Ekind (Comp_Unit) = E_Generic_Package)
               and then not In_Private_Part (Comp_Unit)
+              and then not In_Instance
             then
                Install_Private_With_Clauses (Comp_Unit);
                Private_With_Clauses_Installed := True;
@@ -2088,7 +2092,7 @@ package body Sem_Ch7 is
 
             else
                Error_Msg_N
-                  ("missing full declaration for deferred constant ('R'M 7.4)",
+                  ("missing full declaration for deferred constant (RM 7.4)",
                      Id);
 
                if Is_Limited_Type (Etype (Id)) then

gcc/ada/sem_dist.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -36,12 +36,14 @@ with Namet;    use Namet;
 with Opt;      use Opt;
 with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
+with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
 with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
 with Stand;    use Stand;
 with Stringt;  use Stringt;
 with Tbuild;   use Tbuild;
+with Uintp;    use Uintp;
 
 package body Sem_Dist is
 
@@ -202,13 +204,36 @@ package body Sem_Dist is
    ------------------
 
    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;
+      return
+        Chars (Entity (Expression (Parent (RTE (RE_DSA_Implementation)))));
    end Get_PCS_Name;
 
+   ---------------------
+   -- Get_PCS_Version --
+   ---------------------
+
+   function Get_PCS_Version return Int is
+      PCS_Version_Entity : Entity_Id;
+      PCS_Version        : Int;
+
+   begin
+      if RTE_Available (RE_PCS_Version) then
+         PCS_Version_Entity := RTE (RE_PCS_Version);
+         pragma Assert (Ekind (PCS_Version_Entity) = E_Named_Integer);
+         PCS_Version :=
+           UI_To_Int (Expr_Value (Constant_Value (PCS_Version_Entity)));
+
+      else
+         --  Case of System.Partition_Interface.PCS_Version not found:
+         --  return a null version.
+
+         PCS_Version := 0;
+      end if;
+
+      return PCS_Version;
+   end Get_PCS_Version;
+
    ------------------------
    -- Is_All_Remote_Call --
    ------------------------

gcc/ada/sem_dist.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -35,6 +35,12 @@ package Sem_Dist is
    --  Return the name of a literal of type System.Partition_Interface.
    --  DSA_Implementation_Type indicating what PCS is currently in use.
 
+   function Get_PCS_Version return Int;
+   --  Return the version number of the PCS API implemented by the PCS.
+   --  The consistency of this version with the one expected by Exp_Dist
+   --  (Gnatvsn.PCS_Version_Number) in Rtsfind.Check_RPC.
+   --  If no PCS version information is available, 0 is returned.
+
    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

gcc/ada/sinfo.adb

@@ -1550,14 +1550,6 @@ package body Sinfo is
       return Flag7 (N);
    end Is_Asynchronous_Call_Block;
 
-   function Is_Coextension
-      (N : Node_Id) return Boolean is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Allocator);
-      return Flag18 (N);
-   end Is_Coextension;
-
    function Is_Component_Left_Opnd
       (N : Node_Id) return Boolean is
    begin
@@ -1582,6 +1574,14 @@ package body Sinfo is
       return Flag16 (N);
    end Is_Controlling_Actual;
 
+   function Is_Dynamic_Coextension
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Allocator);
+      return Flag18 (N);
+   end Is_Dynamic_Coextension;
+
    function Is_Entry_Barrier_Function
       (N : Node_Id) return Boolean is
    begin
@@ -4249,14 +4249,6 @@ package body Sinfo is
       Set_Flag7 (N, Val);
    end Set_Is_Asynchronous_Call_Block;
 
-   procedure Set_Is_Coextension
-      (N : Node_Id; Val : Boolean := True) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Allocator);
-      Set_Flag18 (N, Val);
-   end Set_Is_Coextension;
-
    procedure Set_Is_Component_Left_Opnd
       (N : Node_Id; Val : Boolean := True) is
    begin
@@ -4281,6 +4273,14 @@ package body Sinfo is
       Set_Flag16 (N, Val);
    end Set_Is_Controlling_Actual;
 
+   procedure Set_Is_Dynamic_Coextension
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Allocator);
+      Set_Flag18 (N, Val);
+   end Set_Is_Dynamic_Coextension;
+
    procedure Set_Is_Entry_Barrier_Function
       (N : Node_Id; Val : Boolean := True) is
    begin

gcc/ada/sinfo.ads

@@ -630,7 +630,7 @@ package Sinfo is
    --    starting at the highest addressed element. Note that if neither of the
    --    flags Forwards_OK or Backwards_OK is set, it means that the front end
    --    could not determine that either direction is definitely safe, and a
-   --    runtime check is required.
+   --    runtime check may be required if the backend cannot figure it out.
 
    --  Body_To_Inline (Node3-Sem)
    --    present in subprogram declarations. Denotes analyzed but unexpanded
@@ -651,7 +651,7 @@ package Sinfo is
    --    permitted (in Ada 83 or Ada 95).
 
    --  By_Ref (Flag5-Sem)
-   --    A flag present in N_Return_Statement and
+   --    A flag present in N_Simple_Return_Statement and
    --    N_Extended_Return_Statement.
    --    It is set when the returned expression is already allocated on the
    --    secondary stack and thus the result is passed by reference rather
@@ -671,7 +671,7 @@ package Sinfo is
    --    access discriminants of the allocated object.
 
    --  Comes_From_Extended_Return_Statement (Flag18-Sem)
-   --    Present in N_Return_Statement nodes. True if this node was
+   --    Present in N_Simple_Return_Statement nodes. True if this node was
    --    constructed as part of the expansion of an
    --    N_Extended_Return_Statement.
 
@@ -866,7 +866,7 @@ package Sinfo is
    --  Do_Tag_Check (Flag13-Sem)
    --    This flag is set on an N_Assignment_Statement, N_Function_Call,
    --    N_Procedure_Call_Statement, N_Type_Conversion,
-   --    N_Return_Statement, or N_Extended_Return_Statement
+   --    N_Simple_Return_Statement, or N_Extended_Return_Statement
    --    node to indicate that the tag check can be suppressed. It is not
    --    yet decided how this flag is used (TBD ???).
 
@@ -1145,12 +1145,6 @@ package Sinfo is
    --    expansion of an asynchronous entry call. Such a block needs cleanup
    --    handler to assure that the call is cancelled.
 
-   --  Is_Coextension (Flag18-Sem)
-   --    Present in allocator nodes, to indicate that this is an allocator
-   --    for an access discriminant of a dynamically allocated object. The
-   --    coextension must be deallocated and finalized at the same time as
-   --    the enclosing object.
-
    --  Is_Component_Left_Opnd  (Flag13-Sem)
    --  Is_Component_Right_Opnd (Flag14-Sem)
    --    Present in concatenation nodes, to indicate that the corresponding
@@ -1162,6 +1156,12 @@ package Sinfo is
    --    a dispatching call. It is off in all other cases. See Sem_Disp for
    --    details of its use.
 
+   --  Is_Dynamic_Coextension (Flag18-Sem)
+   --    Present in allocator nodes, to indicate that this is an allocator
+   --    for an access discriminant of a dynamically allocated object. The
+   --    coextension must be deallocated and finalized at the same time as
+   --    the enclosing object.
+
    --  Is_Entry_Barrier_Function (Flag8-Sem)
    --    This flag is set in an N_Subprogram_Body node which is the expansion
    --    of an entry barrier from a protected entry body. It is used for the
@@ -1462,11 +1462,11 @@ package Sinfo is
    --    is used to clarify output from the packed array cases.
 
    --  Procedure_To_Call (Node2-Sem)
-   --    Present in N_Allocator, N_Free_Statement, N_Return_Statement,
+   --    Present in N_Allocator, N_Free_Statement, N_Simple_Return_Statement,
    --    and N_Extended_Return_Statement nodes. References the entity for the
    --    declaration of the procedure to be called to accomplish the required
    --    operation (i.e. for the Allocate procedure in the case of N_Allocator
-   --    and N_Return_Statement and N_Extended_Return_Statement (for
+   --    and N_Simple_Return_Statement and N_Extended_Return_Statement (for
    --    allocating the return value), and for the Deallocate procedure in the
    --    case of N_Free_Statement.
 
@@ -1497,7 +1497,7 @@ package Sinfo is
    --    renaming declaration allows registering of the proper exception name.
 
    --  Return_Statement_Entity (Node5-Sem)
-   --    Present in N_Return_Statement and N_Extended_Return_Statement.
+   --    Present in N_Simple_Return_Statement and N_Extended_Return_Statement.
    --    Points to an E_Return_Statement representing the return statement.
 
    --  Return_Object_Declarations (List3)
@@ -1547,8 +1547,8 @@ package Sinfo is
    --    Static_Processing_OK flag set.
 
    --  Storage_Pool (Node1-Sem)
-   --    Present in N_Allocator, N_Free_Statement, N_Return_Statement, and
-   --    N_Extended_Return_Statement nodes. References the entity for the
+   --    Present in N_Allocator, N_Free_Statement, N_Simple_Return_Statement,
+   --    and N_Extended_Return_Statement nodes. References the entity for the
    --    storage pool to be used for the allocate or free call or for the
    --    allocation of the returned value from function. Empty indicates that
    --    the global default default pool is to be used. Note that in the case
@@ -3666,7 +3666,7 @@ package Sinfo is
       --  No_Initialization (Flag13-Sem)
       --  Is_Static_Coextension (Flag14-Sem)
       --  Do_Storage_Check (Flag17-Sem)
-      --  Is_Coextension (Flag18-Sem)
+      --  Is_Dynamic_Coextension (Flag18-Sem)
       --  plus fields for expression
 
       ---------------------------------
@@ -4347,7 +4347,9 @@ package Sinfo is
 
       --  RETURN_SUBTYPE_INDICATION ::= SUBTYPE_INDICATION | ACCESS_DEFINITION
 
-      --  So in Ada 2005, RETURN_STATEMENT is no longer a nonterminal
+      --  So in Ada 2005, RETURN_STATEMENT is no longer a nonterminal, but
+      --  "return statement" is defined in 6.5 to mean a
+      --  SIMPLE_RETURN_STATEMENT or an EXTENDED_RETURN_STATEMENT.
 
       --  N_Return_Statement
       --  Sloc points to RETURN
@@ -4359,8 +4361,11 @@ package Sinfo is
       --  By_Ref (Flag5-Sem)
       --  Comes_From_Extended_Return_Statement (Flag18-Sem)
 
-      --  ???N_Return_Statement represents a simple_return_statement,
-      --  and should be renamed to N_Simple_Return_Statement.
+      --  N_Return_Statement represents a simple_return_statement, and is
+      --  renamed to be N_Simple_Return_Statement below. Clients should refer
+      --  to N_Simple_Return_Statement. We retain N_Return_Statement because
+      --  that's how gigi knows it. See also renaming of Make_Return_Statement
+      --  as Make_Simple_Return_Statement in Sem_Util.
 
       --  Note: Return_Statement_Entity points to an E_Return_Statement
 
@@ -4391,7 +4396,7 @@ package Sinfo is
       --  the Return_Statement_Entity represents the statement itself, and the
       --  Defining_Identifier of the Object_Declaration in
       --  Return_Object_Declarations represents the object being
-      --  returned. N_Return_Statement has only the former.
+      --  returned. N_Simple_Return_Statement has only the former.
 
       ------------------------------
       -- 7.1  Package Declaration --
@@ -7091,7 +7096,7 @@ package Sinfo is
       N_Null_Statement,
       N_Raise_Statement,
       N_Requeue_Statement,
-      N_Return_Statement,
+      N_Return_Statement, -- renamed as N_Simple_Return_Statement in Sem_Util
       N_Extended_Return_Statement,
       N_Selective_Accept,
       N_Timed_Entry_Call,
@@ -7850,9 +7855,6 @@ package Sinfo is
    function Is_Asynchronous_Call_Block
      (N : Node_Id) return Boolean;    -- Flag7
 
-   function Is_Coextension
-     (N : Node_Id) return Boolean;    -- Flag18
-
    function Is_Component_Left_Opnd
      (N : Node_Id) return Boolean;    -- Flag13
 
@@ -7862,6 +7864,9 @@ package Sinfo is
    function Is_Controlling_Actual
      (N : Node_Id) return Boolean;    -- Flag16
 
+   function Is_Dynamic_Coextension
+     (N : Node_Id) return Boolean;    -- Flag18
+
    function Is_Entry_Barrier_Function
      (N : Node_Id) return Boolean;    -- Flag8
 
@@ -8705,9 +8710,6 @@ package Sinfo is
    procedure Set_Is_Asynchronous_Call_Block
      (N : Node_Id; Val : Boolean := True);    -- Flag7
 
-   procedure Set_Is_Coextension
-     (N : Node_Id; Val : Boolean := True);    -- Flag18
-
    procedure Set_Is_Component_Left_Opnd
      (N : Node_Id; Val : Boolean := True);    -- Flag13
 
@@ -8717,6 +8719,9 @@ package Sinfo is
    procedure Set_Is_Controlling_Actual
      (N : Node_Id; Val : Boolean := True);    -- Flag16
 
+   procedure Set_Is_Dynamic_Coextension
+     (N : Node_Id; Val : Boolean := True);    -- Flag18
+
    procedure Set_Is_Entry_Barrier_Function
      (N : Node_Id; Val : Boolean := True);    -- Flag8
 
@@ -10807,10 +10812,10 @@ package Sinfo is
    pragma Inline (Instance_Spec);
    pragma Inline (Intval);
    pragma Inline (Is_Asynchronous_Call_Block);
-   pragma Inline (Is_Coextension);
    pragma Inline (Is_Component_Left_Opnd);
    pragma Inline (Is_Component_Right_Opnd);
    pragma Inline (Is_Controlling_Actual);
+   pragma Inline (Is_Dynamic_Coextension);
    pragma Inline (Is_Entry_Barrier_Function);
    pragma Inline (Is_In_Discriminant_Check);
    pragma Inline (Is_Machine_Number);
@@ -11088,10 +11093,10 @@ package Sinfo is
    pragma Inline (Set_Instance_Spec);
    pragma Inline (Set_Intval);
    pragma Inline (Set_Is_Asynchronous_Call_Block);
-   pragma Inline (Set_Is_Coextension);
    pragma Inline (Set_Is_Component_Left_Opnd);
    pragma Inline (Set_Is_Component_Right_Opnd);
    pragma Inline (Set_Is_Controlling_Actual);
+   pragma Inline (Set_Is_Dynamic_Coextension);
    pragma Inline (Set_Is_Entry_Barrier_Function);
    pragma Inline (Set_Is_In_Discriminant_Check);
    pragma Inline (Set_Is_Machine_Number);
@@ -11213,4 +11218,8 @@ package Sinfo is
    pragma Inline (Set_Was_Originally_Stub);
    pragma Inline (Set_Zero_Cost_Handling);
 
+   N_Simple_Return_Statement : constant Node_Kind := N_Return_Statement;
+   --  Rename N_Return_Statement to be N_Simple_Return_Statement. Clients
+   --  should refer to N_Simple_Return_Statement.
+
 end Sinfo;

gcc/ada/system-darwin-x86.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                        GNAT RUN-TIME COMPONENTS                          --
+--                                                                          --
+--                               S Y S T E M                                --
+--                                                                          --
+--                                 S p e c                                  --
+--                          (Darwin/x86 Version)                            --
+--                                                                          --
+--          Copyright (C) 1992-2007, Free Software Foundation, 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;
+   pragma Preelaborable_Initialization (Address);
+   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;
+   pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning
+
+   --  Priority-related Declarations (RM D.1)
+
+   --  The values defined here are derived from the following Darwin
+   --  sources:
+   --
+   --  Libc/pthreads/pthread.c
+   --    pthread_init calls host_info to retrieve the HOST_PRIORITY_INFO.
+   --    This file includes "pthread_internals".
+   --  Libc/pthreads/pthread_internals.h
+   --    This file includes <mach/mach.h>.
+   --  xnu/osfmk/mach/mach.h
+   --    This file includes <mach/mach_types.h>.
+   --  xnu/osfmk/mach/mach_types.h
+   --    This file includes <mach/host_info.h>.
+   --  xnu/osfmk/mach/host_info.h
+   --    This file contains the definition of the host_info_t data structure
+   --    and the function prototype for host_info.
+   --  xnu/osfmk/kern/host.c
+   --    This file defines the function host_info which sets the
+   --    priority_info field of struct host_info_t. This file includes
+   --    <kern/processor.h>.
+   --  xnu/osfmk/kern/processor.h
+   --    This file includes <kern/sched.h>.
+   --  xnu/osfmk/kern/sched.h
+   --    This file defines the values for each level of priority.
+
+   Max_Interrupt_Priority : constant Positive := 63;
+   Max_Priority           : constant Positive := Max_Interrupt_Priority - 1;
+
+   subtype Any_Priority is Integer range 0 .. Max_Interrupt_Priority;
+   subtype Priority is Any_Priority range 0 .. Max_Priority;
+   subtype Interrupt_Priority is Any_Priority
+     range Priority'Last + 1 .. Max_Interrupt_Priority;
+
+   Default_Priority : constant Priority :=
+     (Priority'Last - Priority'First) / 2;
+
+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.
+
+   Backend_Divide_Checks     : constant Boolean := False;
+   Backend_Overflow_Checks   : constant Boolean := False;
+   Command_Line_Args         : constant Boolean := True;
+   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;
+   Machine_Overflows         : constant Boolean := False;
+   Machine_Rounds            : constant Boolean := True;
+   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 := True;
+   GCC_ZCX_Support           : constant Boolean := True;
+
+end System;