[multiple changes]

2009-06-24  Robert Dewar  <dewar@adacore.com>

	* prj-nmsc.adb, prj-nmsc.ads, prj-proc.adb, prj.adb: Minor reformatting

	* a-strsea.adb (Count): Avoid local copy on stack, speed up unmapped
	case.
	(Index): Ditto.

2009-06-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Analyze_One_Call): Check that at least one actual is
	present when checking whether a call may be interpreted as an indexing
	of the result of a call.

	* exp_ch9.adb (Expand_N_Subprogram_Declaration): Place the generated
	body for a null procedure on the freeze actions for the procedure, so
	that it will be analyzed at the proper place without premature freezing
	of actuals.

	* sem_ch3.adb (Check_Completion): Code cleanup. 
	Do not diagnose a null procedure without a body, if previous errors
	have disabled expansion.

2009-06-24  Doug Rupp  <rupp@adacore.com>

	* init.c [VMS] Resignal C$_SIGKILL

2009-06-24  Ed Falis  <falis@adacore.com>

	* s-vxwext.adb, s-vxwext-kernel.adb: Add s-vxwext body for VxWorks 5
	Define ERROR in body for VxWorks 6 kernel

2009-06-24  Pascal Obry  <obry@adacore.com>

	* g-socket.adb, g-socket.ads: Fix possible unexpected constraint error
	in [Send/Receive]_Socket.

From-SVN: r148905

14 files changed, 490 insertions, 242 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a1c4d33..5d58ca3 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,40 @@
+2009-06-24  Robert Dewar  <dewar@adacore.com>
+
+	* prj-nmsc.adb, prj-nmsc.ads, prj-proc.adb, prj.adb: Minor reformatting
+
+	* a-strsea.adb (Count): Avoid local copy on stack, speed up unmapped
+	case.
+	(Index): Ditto.
+
+2009-06-24  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch4.adb (Analyze_One_Call): Check that at least one actual is
+	present when checking whether a call may be interpreted as an indexing
+	of the result of a call.
+
+	* exp_ch9.adb (Expand_N_Subprogram_Declaration): Place the generated
+	body for a null procedure on the freeze actions for the procedure, so
+	that it will be analyzed at the proper place without premature freezing
+	of actuals.
+
+	* sem_ch3.adb (Check_Completion): Code cleanup. 
+	Do not diagnose a null procedure without a body, if previous errors
+	have disabled expansion.
+
+2009-06-24  Doug Rupp  <rupp@adacore.com>
+
+	* init.c [VMS] Resignal C$_SIGKILL
+
+2009-06-24  Ed Falis  <falis@adacore.com>
+
+	* s-vxwext.adb, s-vxwext-kernel.adb: Add s-vxwext body for VxWorks 5
+	Define ERROR in body for VxWorks 6 kernel
+
+2009-06-24  Pascal Obry  <obry@adacore.com>
+
+	* g-socket.adb, g-socket.ads: Fix possible unexpected constraint error
+	in [Send/Receive]_Socket.
+
 2009-06-24  Emmanuel Briot  <briot@adacore.com>
 
 	* prj-proc.adb, prj-proc.ads, prj.ads, prj-nmsc.adb, prj-nmsc.ads,
diff --git a/gcc/ada/a-strsea.adb b/gcc/ada/a-strsea.adb
index b613895..1994745 100644
--- a/gcc/ada/a-strsea.adb
+++ b/gcc/ada/a-strsea.adb
@@ -36,6 +36,7 @@
 --  is specialized (rather than using the general Index routine).
 
 with Ada.Strings.Maps; use Ada.Strings.Maps;
+with System;           use System;
 
 package body Ada.Strings.Search is
 
@@ -77,33 +78,58 @@ package body Ada.Strings.Search is
       Pattern : String;
       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
    is
-      N : Natural;
-      J : Natural;
-
-      Mapped_Source : String (Source'Range);
+      PL1 : constant Integer := Pattern'Length - 1;
+      Num : Natural;
+      Ind : Natural;
+      Cur : Natural;
 
    begin
-      for J in Source'Range loop
-         Mapped_Source (J) := Value (Mapping, Source (J));
-      end loop;
-
       if Pattern = "" then
          raise Pattern_Error;
       end if;
 
-      N := 0;
-      J := Source'First;
+      Num := 0;
+      Ind := Source'First;
 
-      while J <= Source'Last - (Pattern'Length - 1) loop
-         if Mapped_Source (J .. J + (Pattern'Length - 1)) = Pattern then
-            N := N + 1;
-            J := J + Pattern'Length;
-         else
-            J := J + 1;
-         end if;
-      end loop;
+      --  Unmapped case
 
-      return N;
+      if Mapping'Address = Maps.Identity'Address then
+         Ind := Source'First;
+         while Ind <= Source'Length - PL1 loop
+            if Pattern = Source (Ind .. Ind + PL1) then
+               Num := Num + 1;
+               Ind := Ind + Pattern'Length;
+            else
+               Ind := Ind + 1;
+            end if;
+         end loop;
+
+      --  Mapped case
+
+      else
+         Ind := Source'First;
+         while Ind <= Source'Length - PL1 loop
+            Cur := Ind;
+            for K in Pattern'Range loop
+               if Pattern (K) /= Value (Mapping, Source (Cur)) then
+                  Ind := Ind + 1;
+                  goto Cont;
+               else
+                  Cur := Cur + 1;
+               end if;
+            end loop;
+
+            Num := Num + 1;
+            Ind := Ind + Pattern'Length;
+
+         <<Cont>>
+            null;
+         end loop;
+      end if;
+
+      --  Return result
+
+      return Num;
    end Count;
 
    function Count
@@ -111,41 +137,43 @@ package body Ada.Strings.Search is
       Pattern : String;
       Mapping : Maps.Character_Mapping_Function) return Natural
    is
-      Mapped_Source : String (Source'Range);
-      N             : Natural;
-      J             : Natural;
+      PL1 : constant Integer := Pattern'Length - 1;
+      Num : Natural;
+      Ind : Natural;
+      Cur : Natural;
 
    begin
       if Pattern = "" then
          raise Pattern_Error;
       end if;
 
-      --  We make sure Access_Check is unsuppressed so that the Mapping.all
-      --  call will generate a friendly Constraint_Error if the value for
-      --  Mapping is uninitialized (and hence null).
+      --  Check for null pointer in case checks are off
 
-      declare
-         pragma Unsuppress (Access_Check);
+      if Mapping = null then
+         raise Constraint_Error;
+      end if;
 
-      begin
-         for J in Source'Range loop
-            Mapped_Source (J) := Mapping.all (Source (J));
+      Num := 0;
+      Ind := Source'First;
+      while Ind <= Source'Last - PL1 loop
+         Cur := Ind;
+         for K in Pattern'Range loop
+            if Pattern (K) /= Mapping (Source (Cur)) then
+               Ind := Ind + 1;
+               goto Cont;
+            else
+               Cur := Cur + 1;
+            end if;
          end loop;
-      end;
 
-      N := 0;
-      J := Source'First;
+         Num := Num + 1;
+         Ind := Ind + Pattern'Length;
 
-      while J <= Source'Last - (Pattern'Length - 1) loop
-         if Mapped_Source (J .. J + (Pattern'Length - 1)) = Pattern then
-            N := N + 1;
-            J := J + Pattern'Length;
-         else
-            J := J + 1;
-         end if;
+      <<Cont>>
+         null;
       end loop;
 
-      return N;
+      return Num;
    end Count;
 
    function Count
@@ -187,8 +215,8 @@ package body Ada.Strings.Search is
                end if;
             end loop;
 
-            --  Here if J indexes 1st char of token, and all chars
-            --  after J are in the token
+            --  Here if J indexes first char of token, and all chars after J
+            --  are in the token.
 
             Last := Source'Last;
             return;
@@ -211,43 +239,88 @@ package body Ada.Strings.Search is
       Going   : Direction := Forward;
       Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
    is
-      Cur_Index     : Natural;
-      Mapped_Source : String (Source'Range);
+      PL1 : constant Integer := Pattern'Length - 1;
+      Ind : Natural;
+      Cur : Natural;
 
    begin
       if Pattern = "" then
          raise Pattern_Error;
       end if;
 
-      for J in Source'Range loop
-         Mapped_Source (J) := Value (Mapping, Source (J));
-      end loop;
-
       --  Forwards case
 
       if Going = Forward then
-         for J in 1 .. Source'Length - Pattern'Length + 1 loop
-            Cur_Index := Source'First + J - 1;
+         Ind := Source'First;
 
-            if Pattern = Mapped_Source
-                           (Cur_Index .. Cur_Index + Pattern'Length - 1)
-            then
-               return Cur_Index;
-            end if;
-         end loop;
+         --  Unmapped forward case
+
+         if Mapping'Address = Maps.Identity'Address then
+            for J in 1 .. Source'Length - PL1 loop
+               if Pattern = Source (Ind .. Ind + PL1) then
+                  return Ind;
+               else
+                  Ind := Ind + 1;
+               end if;
+            end loop;
+
+         --  Mapped forward case
+
+         else
+            for J in 1 .. Source'Length - PL1 loop
+               Cur := Ind;
+
+               for K in Pattern'Range loop
+                  if Pattern (K) /= Value (Mapping, Source (Cur)) then
+                     goto Cont1;
+                  else
+                     Cur := Cur + 1;
+                  end if;
+               end loop;
+
+               return Ind;
+
+            <<Cont1>>
+               Ind := Ind + 1;
+            end loop;
+         end if;
 
       --  Backwards case
 
       else
-         for J in reverse 1 .. Source'Length - Pattern'Length + 1 loop
-            Cur_Index := Source'First + J - 1;
+         --  Unmapped backward case
 
-            if Pattern = Mapped_Source
-                           (Cur_Index .. Cur_Index + Pattern'Length - 1)
-            then
-               return Cur_Index;
-            end if;
-         end loop;
+         Ind := Source'Last - PL1;
+
+         if Mapping'Address = Maps.Identity'Address then
+            for J in reverse 1 .. Source'Length - PL1 loop
+               if Pattern = Source (Ind .. Ind + PL1) then
+                  return Ind;
+               else
+                  Ind := Ind - 1;
+               end if;
+            end loop;
+
+         --  Mapped backward case
+
+         else
+            for J in reverse 1 .. Source'Length - PL1 loop
+               Cur := Ind;
+
+               for K in Pattern'Range loop
+                  if Pattern (K) /= Value (Mapping, Source (Cur)) then
+                     goto Cont2;
+                  else
+                     Cur := Cur + 1;
+                  end if;
+               end loop;
+
+               return Ind;
+
+            <<Cont2>>
+               Ind := Ind - 1;
+            end loop;
+         end if;
       end if;
 
       --  Fall through if no match found. Note that the loops are skipped
@@ -262,53 +335,67 @@ package body Ada.Strings.Search is
       Going   : Direction := Forward;
       Mapping : Maps.Character_Mapping_Function) return Natural
    is
-      Mapped_Source : String (Source'Range);
-      Cur_Index     : Natural;
+      PL1 : constant Integer := Pattern'Length - 1;
+      Ind : Natural;
+      Cur : Natural;
 
    begin
       if Pattern = "" then
          raise Pattern_Error;
       end if;
 
-      --  We make sure Access_Check is unsuppressed so that the Mapping.all
-      --  call will generate a friendly Constraint_Error if the value for
-      --  Mapping is uninitialized (and hence null).
+      --  Check for null pointer in case checks are off
 
-      declare
-         pragma Unsuppress (Access_Check);
-      begin
-         for J in Source'Range loop
-            Mapped_Source (J) := Mapping.all (Source (J));
-         end loop;
-      end;
+      if Mapping = null then
+         raise Constraint_Error;
+      end if;
 
       --  Forwards case
 
       if Going = Forward then
-         for J in 1 .. Source'Length - Pattern'Length + 1 loop
-            Cur_Index := Source'First + J - 1;
+         Ind := Source'First;
+         for J in 1 .. Source'Length - PL1 loop
+            Cur := Ind;
+
+            for K in Pattern'Range loop
+               if Pattern (K) /= Mapping.all (Source (Cur)) then
+                  goto Cont1;
+               else
+                  Cur := Cur + 1;
+               end if;
+            end loop;
 
-            if Pattern = Mapped_Source
-                           (Cur_Index .. Cur_Index + Pattern'Length - 1)
-            then
-               return Cur_Index;
-            end if;
+            return Ind;
+
+         <<Cont1>>
+            Ind := Ind + 1;
          end loop;
 
       --  Backwards case
 
       else
-         for J in reverse 1 .. Source'Length - Pattern'Length + 1 loop
-            Cur_Index := Source'First + J - 1;
+         Ind := Source'Last - PL1;
+         for J in reverse 1 .. Source'Length - PL1 loop
+            Cur := Ind;
+
+            for K in Pattern'Range loop
+               if Pattern (K) /= Mapping.all (Source (Cur)) then
+                  goto Cont2;
+               else
+                  Cur := Cur + 1;
+               end if;
+            end loop;
 
-            if Pattern = Mapped_Source
-                           (Cur_Index .. Cur_Index + Pattern'Length - 1)
-            then
-               return Cur_Index;
-            end if;
+            return Ind;
+
+         <<Cont2>>
+            Ind := Ind - 1;
          end loop;
       end if;
 
+      --  Fall through if no match found. Note that the loops are skipped
+      --  completely in the case of the pattern being longer than the source.
+
       return 0;
    end Index;
 
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 011472d..0b4ea23 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -4440,35 +4440,24 @@ package body Exp_Ch6 is
             Pop_Scope;
          end if;
 
-      --  Ada 2005 (AI-348): Generation of the null body
+      --  Ada 2005 (AI-348): Generate body for a null procedure.
+      --  In most cases this is superfluous because calls to it
+      --  will be automatically inlined, but we definitely need
+      --  the body if preconditions for the procedure are present.
 
       elsif Nkind (Specification (N)) = N_Procedure_Specification
         and then Null_Present (Specification (N))
       then
          declare
-            Bod : constant Node_Id :=
-                    Make_Subprogram_Body (Loc,
-                      Specification =>
-                        New_Copy_Tree (Specification (N)),
-                      Declarations => New_List,
-                     Handled_Statement_Sequence =>
-                        Make_Handled_Sequence_Of_Statements (Loc,
-                          Statements => New_List (Make_Null_Statement (Loc))));
+            Bod : constant Node_Id := Body_To_Inline (N);
          begin
-            Set_Body_To_Inline (N, Bod);
-            Insert_After (N, Bod);
-            Analyze (Bod);
+            Set_Has_Completion (Subp, False);
+            Append_Freeze_Action (Subp, Bod);
 
-            --  Corresponding_Spec isn't being set by Analyze_Subprogram_Body,
-            --  evidently because Set_Has_Completion is called earlier for null
-            --  procedures in Analyze_Subprogram_Declaration, so we force its
-            --  setting here. If the setting of Has_Completion is not set
-            --  earlier, then it can result in missing body errors if other
-            --  errors were already reported (since expansion is turned off).
+            --  The body now contains raise statements, so calls to it will
+            --  not be inlined.
 
-            --  Should creation of the empty body be moved to the analyzer???
-
-            Set_Corresponding_Spec (Bod, Defining_Entity (Specification (N)));
+            Set_Is_Inlined (Subp, False);
          end;
       end if;
    end Expand_N_Subprogram_Declaration;
@@ -4910,8 +4899,8 @@ package body Exp_Ch6 is
       --  Check if this is a declared null procedure
 
       elsif Nkind (Decl) = N_Subprogram_Declaration then
-         if Null_Present (Specification (Decl)) then
-            return True;
+         if not Null_Present (Specification (Decl)) then
+            return False;
 
          elsif No (Body_To_Inline (Decl)) then
             return False;
@@ -4936,8 +4925,9 @@ package body Exp_Ch6 is
                   Stat2 := Next (Stat);
 
                   return
-                    Nkind (Stat) = N_Null_Statement
-                      and then
+                     Is_Empty_List (Declarations (Orig_Bod))
+                       and then Nkind (Stat) = N_Null_Statement
+                       and then
                         (No (Stat2)
                           or else
                             (Nkind (Stat2) = N_Simple_Return_Statement
diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb
index b15f52f..909cf0d 100644
--- a/gcc/ada/g-socket.adb
+++ b/gcc/ada/g-socket.adb
@@ -1617,7 +1617,15 @@ package body GNAT.Sockets is
          Raise_Socket_Error (Socket_Errno);
       end if;
 
-      Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
+      if Res = 0
+        and then Item'First = Ada.Streams.Stream_Element_Offset'First
+      then
+         --  No data sent and first index is first Stream_Element_Offset'First
+         --  Last is set to Stream_Element_Offset'Last.
+         Last := Ada.Streams.Stream_Element_Offset'Last;
+      else
+         Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
+      end if;
    end Receive_Socket;
 
    --------------------
@@ -1889,7 +1897,15 @@ package body GNAT.Sockets is
          Raise_Socket_Error (Socket_Errno);
       end if;
 
-      Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
+      if Res = 0
+        and then Item'First = Ada.Streams.Stream_Element_Offset'First
+      then
+         --  No data sent and first index is first Stream_Element_Offset'First
+         --  Last is set to Stream_Element_Offset'Last.
+         Last := Ada.Streams.Stream_Element_Offset'Last;
+      else
+         Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
+      end if;
    end Send_Socket;
 
    -----------------
diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads
index e84bd0f..593c96e 100644
--- a/gcc/ada/g-socket.ads
+++ b/gcc/ada/g-socket.ads
@@ -895,9 +895,10 @@ package GNAT.Sockets is
       Flags  : Request_Flag_Type := No_Request_Flag);
    --  Receive message from Socket. Last is the index value such that Item
    --  (Last) is the last character assigned. Note that Last is set to
-   --  Item'First - 1 when the socket has been closed by peer. This is not an
-   --  error and no exception is raised. Flags allows to control the
-   --  reception. Raise Socket_Error on error.
+   --  Item'First - 1 (or to Stream_Element_Array'Last if Item'First is
+   --  Stream_Element_Offset'First) when the socket has been closed by peer.
+   --  This is not an error and no exception is raised. Flags allows to
+   --  control the reception. Raise Socket_Error on error.
 
    procedure Receive_Socket
      (Socket : Socket_Type;
@@ -933,11 +934,16 @@ package GNAT.Sockets is
       To     : access Sock_Addr_Type;
       Flags  : Request_Flag_Type := No_Request_Flag);
    pragma Inline (Send_Socket);
-   --  Transmit a message over a socket. For a datagram socket, the address is
-   --  given by To.all. For a stream socket, To must be null. Flags
-   --  allows to control the transmission. Raises Socket_Error on error.
-   --  Note: this subprogram is inlined because it is also used to implement
-   --  the two variants below.
+   --  Transmit a message over a socket. For a datagram socket, the address
+   --  is given by To.all. For a stream socket, To must be null. Last is
+   --  the index value such that Item (Last) is the last character
+   --  sent. Note that Last is set to Item'First - 1 (or to
+   --  Stream_Element_Array'Last if Item'First is
+   --  Stream_Element_Offset'First) when the socket has been closed by
+   --  peer.  This is not an error and no exception is raised. Flags allows
+   --  to control the transmission. Raises Socket_Error on error.  Note:
+   --  this subprogram is inlined because it is also used to implement the
+   --  two variants below.
 
    procedure Send_Socket
      (Socket : Socket_Type;
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index 1a24b67..8d9b195 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -1136,6 +1136,7 @@ extern char *__gnat_error_prehandler_stack;   /* Alternate signal stack */
 #define SS$_RESIGNAL        2328
 
 /* These codes are in standard message libraries.  */
+extern int C$_SIGKILL;
 extern int CMA$_EXIT_THREAD;
 extern int SS$_DEBUG;
 extern int SS$_INTDIV;
@@ -1312,6 +1313,7 @@ typedef int
 resignal_predicate (int code);
 
 const int *cond_resignal_table [] = {
+  &C$_SIGKILL,
   &CMA$_EXIT_THREAD,
   &SS$_DEBUG,
   &LIB$_KEYNOTFOU,
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index c503b5e..d3e6be3 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -355,10 +355,10 @@ package body Prj.Nmsc is
       In_Tree               : Project_Tree_Ref;
       Explicit_Sources_Only : Boolean;
       Proc_Data             : in out Processing_Data);
-   --  Find all Ada sources by traversing all source directories.
-   --  If Explicit_Sources_Only is True, then the sources found must belong to
-   --  the list of sources specified explicitly in the project file.
-   --  If Explicit_Sources_Only is False, then all sources matching the naming
+   --  Find all Ada sources by traversing all source directories. If
+   --  Explicit_Sources_Only is True, then the sources found must belong to
+   --  the list of sources specified explicitly in the project file. If
+   --  Explicit_Sources_Only is False, then all sources matching the naming
    --  scheme are recorded.
 
    function Compute_Directory_Last (Dir : String) return Natural;
@@ -375,30 +375,29 @@ package body Prj.Nmsc is
    --  Error_Report.
 
    procedure Search_Directories
-     (Project         : Project_Id;
-      In_Tree         : Project_Tree_Ref;
-      For_All_Sources : Boolean;
+     (Project                   : Project_Id;
+      In_Tree                   : Project_Tree_Ref;
+      For_All_Sources           : Boolean;
       Allow_Duplicate_Basenames : Boolean);
-   --  Search the source directories to find the sources.
-   --  If For_All_Sources is True, check each regular file name against the
-   --  naming schemes of the different languages. Otherwise consider only the
-   --  file names in the hash table Source_Names.
-   --  If Allow_Duplicate_Basenames, then files with the same base names are
-   --  authorized within a project for source-based languages (never for unit
-   --  based languages)
+   --  Search the source directories to find the sources. If For_All_Sources is
+   --  True, check each regular file name against the naming schemes of the
+   --  different languages. Otherwise consider only the file names in the hash
+   --  table Source_Names. If Allow_Duplicate_Basenames, then files with the
+   --  same base names are authorized within a project for source-based
+   --  languages (never for unit based languages)
 
    procedure Check_File
-     (Project           : Project_Id;
-      In_Tree           : Project_Tree_Ref;
-      Path              : Path_Name_Type;
-      File_Name         : File_Name_Type;
-      Display_File_Name : File_Name_Type;
-      For_All_Sources   : Boolean;
+     (Project                   : Project_Id;
+      In_Tree                   : Project_Tree_Ref;
+      Path                      : Path_Name_Type;
+      File_Name                 : File_Name_Type;
+      Display_File_Name         : File_Name_Type;
+      For_All_Sources           : Boolean;
       Allow_Duplicate_Basenames : Boolean);
    --  Check if file File_Name is a valid source of the project. This is used
-   --  in multi-language mode only.
-   --  When the file matches one of the naming schemes, it is added to
-   --  various htables through Add_Source and to Source_Paths_Htable.
+   --  in multi-language mode only. When the file matches one of the naming
+   --  schemes, it is added to various htables through Add_Source and to
+   --  Source_Paths_Htable.
    --
    --  Name is the name of the candidate file. It hasn't been normalized yet
    --  and is the direct result of readdir().
@@ -441,8 +440,8 @@ package body Prj.Nmsc is
    --  Free the internal hash tables used for checking naming exceptions
 
    procedure Get_Directories
-     (Project : Project_Id;
-      In_Tree : Project_Tree_Ref;
+     (Project     : Project_Id;
+      In_Tree     : Project_Tree_Ref;
       Current_Dir : String);
    --  Get the object directory, the exec directory and the source directories
    --  of a project.
@@ -535,17 +534,16 @@ package body Prj.Nmsc is
    --  computing
 
    procedure Look_For_Sources
-     (Project     : Project_Id;
-      In_Tree     : Project_Tree_Ref;
-      Proc_Data   : in out Processing_Data;
+     (Project                   : Project_Id;
+      In_Tree                   : Project_Tree_Ref;
+      Proc_Data                 : in out Processing_Data;
       Allow_Duplicate_Basenames : Boolean);
    --  Find all the sources of project Project in project tree In_Tree and
    --  update its Data accordingly. This assumes that Data.First_Source has
    --  been initialized with the list of excluded sources and special naming
-   --  exceptions.
-   --  If Allow_Duplicate_Basenames, then files with the same base names are
-   --  authorized within a project for source-based languages (never for unit
-   --  based languages)
+   --  exceptions. If Allow_Duplicate_Basenames, then files with the same base
+   --  names are authorized within a project for source-based languages (never
+   --  for unit based languages)
 
    function Path_Name_Of
      (File_Name : File_Name_Type;
@@ -570,8 +568,8 @@ package body Prj.Nmsc is
       Location        : Source_Ptr;
       Source_Recorded : in out Boolean);
    --  Put a unit in the list of units of a project, if the file name
-   --  corresponds to a valid unit name.
-   --  Ada_Language is a pointer to the Language_Data for "Ada" in Project.
+   --  corresponds to a valid unit name. Ada_Language is a pointer to the
+   --  Language_Data for "Ada" in Project.
 
    procedure Remove_Source
      (Id          : Source_Id;
@@ -6765,9 +6763,9 @@ package body Prj.Nmsc is
    ------------------
 
    procedure Find_Sources
-     (Project   : Project_Id;
-      In_Tree   : Project_Tree_Ref;
-      Proc_Data : in out Processing_Data;
+     (Project                   : Project_Id;
+      In_Tree                   : Project_Tree_Ref;
+      Proc_Data                 : in out Processing_Data;
       Allow_Duplicate_Basenames : Boolean)
    is
       Sources          : constant Variable_Value :=
@@ -6927,13 +6925,14 @@ package body Prj.Nmsc is
 
       if Get_Mode = Ada_Only then
          Find_Ada_Sources
-           (Project, In_Tree, Explicit_Sources_Only => Has_Explicit_Sources,
-            Proc_Data => Proc_Data);
+           (Project, In_Tree,
+            Explicit_Sources_Only => Has_Explicit_Sources,
+            Proc_Data             => Proc_Data);
 
       else
          Search_Directories
            (Project, In_Tree,
-            For_All_Sources =>
+            For_All_Sources           =>
               Sources.Default and then Source_List_File.Default,
             Allow_Duplicate_Basenames => Allow_Duplicate_Basenames);
       end if;
@@ -7346,12 +7345,12 @@ package body Prj.Nmsc is
    ----------------
 
    procedure Check_File
-     (Project           : Project_Id;
-      In_Tree           : Project_Tree_Ref;
-      Path              : Path_Name_Type;
-      File_Name         : File_Name_Type;
-      Display_File_Name : File_Name_Type;
-      For_All_Sources   : Boolean;
+     (Project                   : Project_Id;
+      In_Tree                   : Project_Tree_Ref;
+      Path                      : Path_Name_Type;
+      File_Name                 : File_Name_Type;
+      Display_File_Name         : File_Name_Type;
+      For_All_Sources           : Boolean;
       Allow_Duplicate_Basenames : Boolean)
    is
       Canonical_Path : constant Path_Name_Type :=
@@ -7464,7 +7463,9 @@ package body Prj.Nmsc is
                        or else
                     (Source.Kind = Impl and then Kind = Spec))
                then
-                  null; --  We found the "other_part (source)"
+                  --  We found the "other_part (source)"
+
+                  null;
 
                elsif (Unit /= No_Name
                       and then Source.Unit /= No_Unit_Index
@@ -7566,9 +7567,9 @@ package body Prj.Nmsc is
    ------------------------
 
    procedure Search_Directories
-     (Project         : Project_Id;
-      In_Tree         : Project_Tree_Ref;
-      For_All_Sources : Boolean;
+     (Project                   : Project_Id;
+      In_Tree                   : Project_Tree_Ref;
+      For_All_Sources           : Boolean;
       Allow_Duplicate_Basenames : Boolean)
    is
       Source_Dir        : String_List_Id;
@@ -7642,12 +7643,16 @@ package body Prj.Nmsc is
 
                         declare
                            Path_Name : constant String :=
-                               Normalize_Pathname
-                                 (Name (1 .. Last),
-                                  Directory      => Source_Directory
-                                    (Source_Directory'First .. Dir_Last),
-                                  Resolve_Links  => Opt.Follow_Links_For_Files,
-                                  Case_Sensitive => True); --  no folding
+                                         Normalize_Pathname
+                                           (Name (1 .. Last),
+                                            Directory       =>
+                                              Source_Directory
+                                                (Source_Directory'First ..
+                                                 Dir_Last),
+                                            Resolve_Links   =>
+                                              Opt.Follow_Links_For_Files,
+                                            Case_Sensitive => True);
+                           --  Case_Sensitive set True (no folding)
 
                            Path : Path_Name_Type;
                            FF   : File_Found :=
@@ -7672,12 +7677,13 @@ package body Prj.Nmsc is
 
                            else
                               Check_File
-                                (Project           => Project,
-                                 In_Tree           => In_Tree,
-                                 Path              => Path,
-                                 File_Name         => File_Name,
-                                 Display_File_Name => Display_File_Name,
-                                 For_All_Sources   => For_All_Sources,
+                                (Project                   => Project,
+                                 In_Tree                   => In_Tree,
+                                 Path                      => Path,
+                                 File_Name                 => File_Name,
+                                 Display_File_Name         =>
+                                   Display_File_Name,
+                                 For_All_Sources           => For_All_Sources,
                                  Allow_Duplicate_Basenames =>
                                    Allow_Duplicate_Basenames);
                            end if;
@@ -7775,9 +7781,9 @@ package body Prj.Nmsc is
    ----------------------
 
    procedure Look_For_Sources
-     (Project     : Project_Id;
-      In_Tree     : Project_Tree_Ref;
-      Proc_Data   : in out Processing_Data;
+     (Project                   : Project_Id;
+      In_Tree                   : Project_Tree_Ref;
+      Proc_Data                 : in out Processing_Data;
       Allow_Duplicate_Basenames : Boolean)
    is
       Iter : Source_Iterator;
@@ -7875,6 +7881,7 @@ package body Prj.Nmsc is
 
       procedure Process_Sources_In_Multi_Language_Mode is
          Iter : Source_Iterator;
+
       begin
          --  Check that two sources of this project do not have the same object
          --  file name.
@@ -7947,12 +7954,12 @@ package body Prj.Nmsc is
 
                               declare
                                  Src_Ind : constant Source_File_Index :=
-                                   Sinput.P.Load_Project_File
-                                     (Get_Name_String
-                                          (Src_Id.Path.Name));
+                                             Sinput.P.Load_Project_File
+                                               (Get_Name_String
+                                                 (Src_Id.Path.Name));
                               begin
                                  if Sinput.P.Source_File_Is_Subunit
-                                   (Src_Ind)
+                                      (Src_Ind)
                                  then
                                     Override_Kind (Src_Id, Sep);
                                  else
diff --git a/gcc/ada/prj-nmsc.ads b/gcc/ada/prj-nmsc.ads
index dfb167c..f0f2ee5 100644
--- a/gcc/ada/prj-nmsc.ads
+++ b/gcc/ada/prj-nmsc.ads
@@ -41,13 +41,13 @@ private package Prj.Nmsc is
    --  Free the memory occupied by Proc_Data
 
    procedure Check
-     (Project         : Project_Id;
-      In_Tree         : Project_Tree_Ref;
-      Report_Error    : Put_Line_Access;
-      When_No_Sources : Error_Warning;
-      Current_Dir     : String;
-      Proc_Data       : in out Processing_Data;
-      Is_Config_File  : Boolean;
+     (Project                   : Project_Id;
+      In_Tree                   : Project_Tree_Ref;
+      Report_Error              : Put_Line_Access;
+      When_No_Sources           : Error_Warning;
+      Current_Dir               : String;
+      Proc_Data                 : in out Processing_Data;
+      Is_Config_File            : Boolean;
       Compiler_Driver_Mandatory : Boolean;
       Allow_Duplicate_Basenames : Boolean);
    --  Perform consistency and semantic checks on a project, starting from the
@@ -75,6 +75,7 @@ private package Prj.Nmsc is
    --  If Compiler_Driver_Mandatory is true, then a Compiler.Driver attribute
    --  for each language must be defined, or we will not look for its source
    --  files.
+   --
    --  If Allow_Duplicate_Basenames, then files with the same base names are
    --  authorized within a project for source-based languages (never for unit
    --  based languages)
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index 2946b42..31cd292 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -285,11 +285,11 @@ package body Prj.Proc is
    -----------
 
    procedure Check
-     (In_Tree         : Project_Tree_Ref;
-      Project         : Project_Id;
-      Current_Dir     : String;
-      When_No_Sources : Error_Warning;
-      Is_Config_File  : Boolean;
+     (In_Tree                   : Project_Tree_Ref;
+      Project                   : Project_Id;
+      Current_Dir               : String;
+      When_No_Sources           : Error_Warning;
+      Is_Config_File            : Boolean;
       Compiler_Driver_Mandatory : Boolean;
       Allow_Duplicate_Basenames : Boolean)
    is
@@ -1259,17 +1259,17 @@ package body Prj.Proc is
 
       if not Is_Config_File then
          Process_Project_Tree_Phase_2
-           (In_Tree                => In_Tree,
-            Project                => Project,
-            Success                => Success,
-            From_Project_Node      => From_Project_Node,
-            From_Project_Node_Tree => From_Project_Node_Tree,
-            Report_Error           => Report_Error,
-            When_No_Sources        => When_No_Sources,
-            Current_Dir            => Current_Dir,
+           (In_Tree                   => In_Tree,
+            Project                   => Project,
+            Success                   => Success,
+            From_Project_Node         => From_Project_Node,
+            From_Project_Node_Tree    => From_Project_Node_Tree,
+            Report_Error              => Report_Error,
+            When_No_Sources           => When_No_Sources,
+            Current_Dir               => Current_Dir,
             Compiler_Driver_Mandatory => True,
             Allow_Duplicate_Basenames => False,
-            Is_Config_File         => Is_Config_File);
+            Is_Config_File            => Is_Config_File);
       end if;
    end Process;
 
diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index d3c29c9..4cc0c4d 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -154,7 +154,7 @@ package body Prj is
 
    procedure Language_Changed (Iter : in out Source_Iterator);
    procedure Project_Changed (Iter : in out Source_Iterator);
-   --  Called when a new project or language was selected for this iterator.
+   --  Called when a new project or language was selected for this iterator
 
    function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean;
    --  Return True if there is at least one ALI file in the directory Dir
@@ -845,15 +845,19 @@ package body Prj is
    ---------------
 
    procedure Free_List (Source : in out Source_Id) is
-      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
-        (Source_Data, Source_Id);
+      procedure Unchecked_Free is new
+        Ada.Unchecked_Deallocation (Source_Data, Source_Id);
+
       Tmp : Source_Id;
+
    begin
       while Source /= No_Source loop
          Tmp := Source.Next_In_Lang;
          Free_List (Source.Alternate_Languages);
 
-         if Source.Unit /= null then
+         if Source.Unit /= null
+           and then Source.Kind in Spec_Or_Body
+         then
             Source.Unit.File_Names (Source.Kind) := null;
          end if;
 
@@ -870,8 +874,9 @@ package body Prj is
      (List         : in out Project_List;
       Free_Project : Boolean)
    is
-      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
-        (Project_List_Element, Project_List);
+      procedure Unchecked_Free is new
+        Ada.Unchecked_Deallocation (Project_List_Element, Project_List);
+
       Tmp : Project_List;
 
    begin
@@ -892,9 +897,11 @@ package body Prj is
    ---------------
 
    procedure Free_List (Languages : in out Language_Ptr) is
-      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
-        (Language_Data, Language_Ptr);
+      procedure Unchecked_Free is new
+        Ada.Unchecked_Deallocation (Language_Data, Language_Ptr);
+
       Tmp : Language_Ptr;
+
    begin
       while Languages /= null loop
          Tmp := Languages.Next;
@@ -909,16 +916,18 @@ package body Prj is
    ----------------
 
    procedure Free_Units (Table : in out Units_Htable.Instance) is
-      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
-        (Unit_Data, Unit_Index);
+      procedure Unchecked_Free is new
+        Ada.Unchecked_Deallocation (Unit_Data, Unit_Index);
+
       Unit : Unit_Index;
+
    begin
       Unit := Units_Htable.Get_First (Table);
-
       while Unit /= No_Unit_Index loop
          if Unit.File_Names (Spec) /= null then
             Unit.File_Names (Spec).Unit := No_Unit_Index;
          end if;
+
          if Unit.File_Names (Impl) /= null then
             Unit.File_Names (Impl).Unit := No_Unit_Index;
          end if;
@@ -935,8 +944,8 @@ package body Prj is
    ----------
 
    procedure Free (Tree : in out Project_Tree_Ref) is
-      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
-        (Project_Tree_Data, Project_Tree_Ref);
+      procedure Unchecked_Free is new
+        Ada.Unchecked_Deallocation (Project_Tree_Data, Project_Tree_Ref);
 
    begin
       if Tree /= null then
@@ -1076,6 +1085,7 @@ package body Prj is
    procedure Set_Mode (New_Mode : Mode) is
    begin
       Current_Mode := New_Mode;
+
       case New_Mode is
          when Ada_Only =>
             Default_Language_Is_Ada := True;
@@ -1462,10 +1472,12 @@ package body Prj is
    ----------------------------
 
    function Get_Language_From_Name
-     (Project : Project_Id; Name : String) return Language_Ptr
+     (Project : Project_Id;
+      Name    : String) return Language_Ptr
    is
-      N : Name_Id;
+      N      : Name_Id;
       Result : Language_Ptr;
+
    begin
       Name_Len := Name'Length;
       Name_Buffer (1 .. Name_Len) := Name;
@@ -1484,6 +1496,26 @@ package body Prj is
       return No_Language_Index;
    end Get_Language_From_Name;
 
+   ----------------
+   -- Other_Part --
+   ----------------
+
+   function Other_Part (Source : Source_Id) return Source_Id is
+   begin
+      if Source.Unit /= No_Unit_Index then
+         case Source.Kind is
+            when Impl =>
+               return Source.Unit.File_Names (Spec);
+            when Spec =>
+               return Source.Unit.File_Names (Impl);
+            when Sep =>
+               return No_Source;
+         end case;
+      else
+         return No_Source;
+      end if;
+   end Other_Part;
+
 begin
    --  Make sure that the standard config and user project file extensions are
    --  compatible with canonical case file naming.
diff --git a/gcc/ada/s-vxwext-kernel.adb b/gcc/ada/s-vxwext-kernel.adb
index f93ba6b..a8455bb 100644
--- a/gcc/ada/s-vxwext-kernel.adb
+++ b/gcc/ada/s-vxwext-kernel.adb
@@ -34,6 +34,8 @@
 
 package body System.VxWorks.Ext is
 
+   ERROR : constant := -1;
+
    --------------
    -- Int_Lock --
    --------------
diff --git a/gcc/ada/s-vxwext.adb b/gcc/ada/s-vxwext.adb
new file mode 100644
index 0000000..b13b07e
--- /dev/null
+++ b/gcc/ada/s-vxwext.adb
@@ -0,0 +1,50 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
+--                                                                          --
+--                     S Y S T E M . V X W O R K S . E X T                  --
+--                                                                          --
+--                                   B o d y                                --
+--                                                                          --
+--            Copyright (C) 2009, Free Software Foundation, Inc.            --
+--                                                                          --
+-- GNARL is free software; you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNARL; see file COPYING.  If not, write --
+-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+-- Boston, MA 02110-1301, USA.                                              --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package provides vxworks specific support functions needed
+--  by System.OS_Interface.
+
+--  This is the VxWorks 5.x version of this package
+
+package body System.VxWorks.Ext is
+
+   ERROR : constant := -1;
+
+   ------------------------
+   -- taskCpuAffinitySet --
+   ------------------------
+
+   function taskCpuAffinitySet (tid : t_id; CPU : int) return int is
+      pragma Unreferenced (tid, CPU);
+   begin
+      return ERROR;
+   end taskCpuAffinitySet;
+
+end System.VxWorks.Ext;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 7479d75..828babd 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -8609,23 +8609,39 @@ package body Sem_Ch3 is
          --  source (including the _Call primitive operation of RAS types,
          --  which has to have the flag Comes_From_Source for other purposes):
          --  we assume that the expander will provide the missing completion.
+         --  In case of previous errors, other expansion actions that provide
+         --  bodies for null procedures with not be invoked. so inhibit message
+         --  in those cases.
 
          elsif     Ekind (E) = E_Function
            or else Ekind (E) = E_Procedure
            or else Ekind (E) = E_Generic_Function
            or else Ekind (E) = E_Generic_Procedure
          then
-            if not Has_Completion (E)
-              and then not (Is_Subprogram (E)
-                            and then Is_Abstract_Subprogram (E))
-              and then not (Is_Subprogram (E)
-                              and then
-                            (not Comes_From_Source (E)
-                              or else Chars (E) = Name_uCall))
-              and then Nkind (Parent (Unit_Declaration_Node (E))) /=
-                                                       N_Compilation_Unit
-              and then Chars (E) /= Name_uSize
+            if Has_Completion (E) then
+               null;
+
+            elsif Is_Subprogram (E) and then Is_Abstract_Subprogram (E) then
+               null;
+
+            elsif Is_Subprogram (E)
+              and then (not Comes_From_Source (E)
+                          or else Chars (E) = Name_uCall)
             then
+               null;
+
+            elsif
+               Nkind (Parent (Unit_Declaration_Node (E))) = N_Compilation_Unit
+            then
+               null;
+
+            elsif Nkind (Parent (E)) = N_Procedure_Specification
+              and then Null_Present (Parent (E))
+              and then Serious_Errors_Detected > 0
+            then
+               null;
+
+            else
                Post_Error;
             end if;
 
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index b8e8b42..c9585a08 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -2262,7 +2262,9 @@ package body Sem_Ch4 is
          return;
       end if;
 
-      if Present (Actuals)
+      --  An indexing requires at least one actual.
+
+      if not Is_Empty_List (Actuals)
         and then
           (Needs_No_Actuals (Nam)
             or else