[multiple changes]

2011-08-02  Javier Miranda  <miranda@adacore.com>

	* sem_ch6.adb (Can_Override_Operator): New function.
	(Verify_Overriding_Indicator): Add missing code to check overriding
	indicator in operators. Fixes regression.
	(Check_Overriding_Indicator): Minor reformating after replacing the
	code that evaluates if the subprogram can override an operator by
	invocations to the above new function.
	* einfo.adb
	(Write_Field26_Name): Add missing code to ensure that, following
	the documentation in einfo.ads, this field is not shown as attribute
	"Static_Initialization" on non-dispatching functions.

2011-08-02  Jose Ruiz  <ruiz@adacore.com>

	* sem_res.adb (Resolve_Call): A call to
	Ada.Real_Time.Timing_Events.Set_Handler violates restriction
	No_Relative_Delay (AI-0211) only when it sets a relative timing event,
	i.e., when the second parameter is of type Time_Span.

2011-08-02  Vincent Celier  <celier@adacore.com>

	* make.adb (Gnatmake): use <library dir>/lib<library name>.a to link
	with an archive instead of -L<library dir> -l<library name>.

2011-08-02  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Analyze_Use_Type): If the clause is being re-analyzed,
	mark the base types In_Use in addition to making the operations
	use_visible.

2011-08-02  Ed Falis  <falis@adacore.com>

	* init.c: add and setup __gnat_signal_mask for the exception signals
	* s-inmaop-vxworks.adb: new file.
	* s-intman-vxworks.adb: remove unnecessary initializations and
	simplify remaining
	* s-intman-vxworks.ads: remove unnecessary variable
	* s-taprop-vxworks.adb: simplify signal initialization

From-SVN: r177092

gcc/ada/ChangeLog

+2011-08-02  Javier Miranda  <miranda@adacore.com>
+
+	* sem_ch6.adb (Can_Override_Operator): New function.
+	(Verify_Overriding_Indicator): Add missing code to check overriding
+	indicator in operators. Fixes regression.
+	(Check_Overriding_Indicator): Minor reformating after replacing the
+	code that evaluates if the subprogram can override an operator by
+	invocations to the above new function.
+	* einfo.adb
+	(Write_Field26_Name): Add missing code to ensure that, following
+	the documentation in einfo.ads, this field is not shown as attribute
+	"Static_Initialization" on non-dispatching functions.
+
+2011-08-02  Jose Ruiz  <ruiz@adacore.com>
+
+	* sem_res.adb (Resolve_Call): A call to
+	Ada.Real_Time.Timing_Events.Set_Handler violates restriction
+	No_Relative_Delay (AI-0211) only when it sets a relative timing event,
+	i.e., when the second parameter is of type Time_Span.
+
+2011-08-02  Vincent Celier  <celier@adacore.com>
+
+	* make.adb (Gnatmake): use <library dir>/lib<library name>.a to link
+	with an archive instead of -L<library dir> -l<library name>.
+
+2011-08-02  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb (Analyze_Use_Type): If the clause is being re-analyzed,
+	mark the base types In_Use in addition to making the operations
+	use_visible.
+
+2011-08-02  Ed Falis  <falis@adacore.com>
+
+	* init.c: add and setup __gnat_signal_mask for the exception signals
+	* s-inmaop-vxworks.adb: new file.
+	* s-intman-vxworks.adb: remove unnecessary initializations and
+	simplify remaining
+	* s-intman-vxworks.ads: remove unnecessary variable
+	* s-taprop-vxworks.adb: simplify signal initialization
+
 2011-08-02  Robert Dewar  <dewar@adacore.com>
 
 	* sem_ch8.adb: Minor code reorganization, comment updates.

gcc/ada/einfo.adb

@@ -8497,10 +8497,12 @@ package body Einfo is
 
          when E_Procedure                                  |
               E_Function                                   =>
-            if Is_Dispatching_Operation (Id) then
-               Write_Str ("Overridden_Operation");
-            else
+            if Ekind (Id) = E_Procedure
+              and then not Is_Dispatching_Operation (Id)
+            then
                Write_Str ("Static_Initialization");
+            else
+               Write_Str ("Overridden_Operation");
             end if;
 
          when E_Record_Type                                |

gcc/ada/init.c

@@ -1975,20 +1975,23 @@ __gnat_map_signal (int sig)
 /* Tasking and Non-tasking signal handler.  Map SIGnal to Ada exception
    propagation after the required low level adjustments.  */
 
+sigset_t __gnat_signal_mask;
+
+  /* VxWorks will always mask out the signal during the signal handler and
+     will reenable it on a longjmp.  GNAT does not generate a longjmp to
+     return from a signal handler so exception signals will still be masked
+     unless we unmask it. __gnat_signal mask tells sigaction to block the
+     exception signals and sigprocmask to unblock them. */
+
 void
 __gnat_error_handler (int sig,
 		      void *si ATTRIBUTE_UNUSED,
 		      struct sigcontext *sc ATTRIBUTE_UNUSED)
 {
-  sigset_t mask;
 
-  /* VxWorks will always mask out the signal during the signal handler and
-     will reenable it on a longjmp.  GNAT does not generate a longjmp to
-     return from a signal handler so the signal will still be masked unless
-     we unmask it.  */
-  sigprocmask (SIG_SETMASK, NULL, &mask);
-  sigdelset (&mask, sig);
-  sigprocmask (SIG_SETMASK, &mask, NULL);
+  /* This routine handles the exception signals for all tasks */
+
+  sigprocmask (SIG_UNBLOCK, &__gnat_signal_mask, NULL);
 
   __gnat_map_signal (sig);
 }
@@ -2000,14 +2003,24 @@ __gnat_install_handler (void)
 
   /* Setup signal handler to map synchronous signals to appropriate
      exceptions.  Make sure that the handler isn't interrupted by another
-     signal that might cause a scheduling event!  */
+     signal that might cause a scheduling event! This routine is called
+     only once, for the environment task. Other tasks are set up in the
+     System.Interrupt_Manager package. */
+
+  sigemptyset (&__gnat_signal_mask);
+  sigaddset (SIGBUS, &__gnat_signal_mask);
+  sigaddset (SIGFPE, &__gnat_signal_mask);
+  sigaddset (SIGILL, &__gnat_signal_mask);
+  sigaddset (SIGSEGV, &__gnat_signal_mask);
 
   act.sa_handler = __gnat_error_handler;
   act.sa_flags = SA_SIGINFO | SA_ONSTACK;
-  sigemptyset (&act.sa_mask);
+  act.sa_mask = __gnat_signal_mask;
+
+  /* For VxWorks, unconditionally install the exception signal handlers, since
+     pragma Interrupt_State applies to vectored hardware interrupts, not
+     signals.  */
 
-  /* For VxWorks, install all signal handlers, since pragma Interrupt_State
-     applies to vectored hardware interrupts, not signals.  */
   sigaction (SIGFPE,  &act, NULL);
   sigaction (SIGILL,  &act, NULL);
   sigaction (SIGSEGV, &act, NULL);
@@ -2027,6 +2040,7 @@ __gnat_init_float (void)
      below have no effect.  */
 #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT) && !defined (VTHREADS)
 #if defined (__SPE__)
+  /* VxWorks 6 */
   {
      const unsigned long spefscr_mask = 0xfffffff3;
      unsigned long spefscr;
@@ -2035,6 +2049,7 @@ __gnat_init_float (void)
      asm ("mtspr 512, %0\n\tisync" : : "r" (spefscr));
   }
 #else
+  /* all except VxWorks 653 and MILS */
   asm ("mtfsb0 25");
   asm ("mtfsb0 26");
 #endif
@@ -2042,7 +2057,7 @@ __gnat_init_float (void)
 
 #if (defined (__i386__) || defined (i386)) && !defined (VTHREADS)
   /* This is used to properly initialize the FPU on an x86 for each
-     process thread.  */
+     process thread. For all except VxWorks 653 */
   asm ("finit");
 #endif
 

gcc/ada/make.adb

@@ -6066,24 +6066,41 @@ package body Make is
                      end loop;
 
                      for Index in 1 .. Library_Projs.Last loop
+                        if
+                          Library_Projs.Table (Index).Library_Kind = Static
+                        then
+                           Linker_Switches.Increment_Last;
+                           Linker_Switches.Table (Linker_Switches.Last) :=
+                             new String'
+                               (Get_Name_String
+                                    (Library_Projs.Table (Index).
+                                       Library_Dir.Display_Name) &
+                                Directory_Separator &
+                                "lib" &
+                                Get_Name_String
+                                    (Library_Projs.Table (Index).
+                                     Library_Name) &
+                                ".a");
 
-                        --  Add the -L switch
-
-                        Linker_Switches.Increment_Last;
-                        Linker_Switches.Table (Linker_Switches.Last) :=
-                          new String'("-L" &
-                                      Get_Name_String
-                                        (Library_Projs.Table (Index).
-                                            Library_Dir.Display_Name));
-
-                        --  Add the -l switch
-
-                        Linker_Switches.Increment_Last;
-                        Linker_Switches.Table (Linker_Switches.Last) :=
-                          new String'("-l" &
-                                      Get_Name_String
-                                        (Library_Projs.Table (Index).
-                                           Library_Name));
+                        else
+                           --  Add the -L switch
+
+                           Linker_Switches.Increment_Last;
+                           Linker_Switches.Table (Linker_Switches.Last) :=
+                             new String'("-L" &
+                               Get_Name_String
+                                 (Library_Projs.Table (Index).
+                                    Library_Dir.Display_Name));
+
+                           --  Add the -l switch
+
+                           Linker_Switches.Increment_Last;
+                           Linker_Switches.Table (Linker_Switches.Last) :=
+                             new String'("-l" &
+                               Get_Name_String
+                                 (Library_Projs.Table (Index).
+                                    Library_Name));
+                        end if;
                      end loop;
                   end if;
 

gcc/ada/s-inmaop-vxworks.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
+--                                                                          --
+--                  SYSTEM.INTERRUPT_MANAGEMENT.OPERATIONS                  --
+--                                                                          --
+--                                  B o d y                                 --
+--                                                                          --
+--             Copyright (C) 1991-1994, Florida State University            --
+--                     Copyright (C) 1995-2010, 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 3,  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.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNARL was developed by the GNARL team at Florida State University.       --
+-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is a VxWorks version of this package. Many operations are null as this
+--  package supports the use of Ada interrupt handling facilities for signals,
+--  while those facilities are used for hardware interrupts on these targets.
+
+with Ada.Exceptions;
+
+with Interfaces.C;
+
+with System.OS_Interface;
+
+package body System.Interrupt_Management.Operations is
+
+   use Ada.Exceptions;
+   use Interfaces.C;
+   use System.OS_Interface;
+
+   ----------------------------
+   -- Thread_Block_Interrupt --
+   ----------------------------
+
+   procedure Thread_Block_Interrupt
+     (Interrupt : Interrupt_ID)
+   is
+      pragma Unreferenced (Interrupt);
+   begin
+      Raise_Exception
+        (Program_Error'Identity,
+         "Thread_Block_Interrupt unimplemented");
+   end Thread_Block_Interrupt;
+
+   ------------------------------
+   -- Thread_Unblock_Interrupt --
+   ------------------------------
+
+   procedure Thread_Unblock_Interrupt
+     (Interrupt : Interrupt_ID)
+   is
+      pragma Unreferenced (Interrupt);
+   begin
+      Raise_Exception
+        (Program_Error'Identity,
+         "Thread_Unblock_Interrupt unimplemented");
+   end Thread_Unblock_Interrupt;
+
+   ------------------------
+   -- Set_Interrupt_Mask --
+   ------------------------
+
+   procedure Set_Interrupt_Mask (Mask : access Interrupt_Mask) is
+      pragma Unreferenced (Mask);
+   begin
+      null;
+   end Set_Interrupt_Mask;
+
+   procedure Set_Interrupt_Mask
+     (Mask  : access Interrupt_Mask;
+      OMask : access Interrupt_Mask)
+   is
+      pragma Unreferenced (Mask, OMask);
+   begin
+      Raise_Exception
+        (Program_Error'Identity,
+         "Set_Interrupt_Mask unimplemented");
+   end Set_Interrupt_Mask;
+
+   ------------------------
+   -- Get_Interrupt_Mask --
+   ------------------------
+
+   procedure Get_Interrupt_Mask (Mask : access Interrupt_Mask) is
+      pragma Unreferenced (Mask);
+   begin
+      Raise_Exception
+        (Program_Error'Identity,
+         "Get_Interrupt_Mask unimplemented");
+   end Get_Interrupt_Mask;
+
+   --------------------
+   -- Interrupt_Wait --
+   --------------------
+
+   function Interrupt_Wait
+     (Mask : access Interrupt_Mask) return Interrupt_ID
+   is
+      pragma Unreferenced (Mask);
+   begin
+      Raise_Exception
+        (Program_Error'Identity,
+         "Interrupt_Wait unimplemented");
+      return 0;
+   end Interrupt_Wait;
+
+   ----------------------------
+   -- Install_Default_Action --
+   ----------------------------
+
+   procedure Install_Default_Action (Interrupt : Interrupt_ID) is
+      pragma Unreferenced (Interrupt);
+   begin
+      Raise_Exception
+        (Program_Error'Identity,
+         "Install_Default_Action unimplemented");
+   end Install_Default_Action;
+
+   ---------------------------
+   -- Install_Ignore_Action --
+   ---------------------------
+
+   procedure Install_Ignore_Action (Interrupt : Interrupt_ID) is
+      pragma Unreferenced (Interrupt);
+   begin
+      Raise_Exception
+        (Program_Error'Identity,
+         "Install_Ignore_Action unimplemented");
+   end Install_Ignore_Action;
+
+   -------------------------
+   -- Fill_Interrupt_Mask --
+   -------------------------
+
+   procedure Fill_Interrupt_Mask (Mask : access Interrupt_Mask) is
+      pragma Unreferenced (Mask);
+   begin
+      Raise_Exception
+        (Program_Error'Identity,
+         "Fill_Interrupt_Mask unimplemented");
+   end Fill_Interrupt_Mask;
+
+   --------------------------
+   -- Empty_Interrupt_Mask --
+   --------------------------
+
+   procedure Empty_Interrupt_Mask (Mask : access Interrupt_Mask) is
+      pragma Unreferenced (Mask);
+   begin
+      Raise_Exception
+        (Program_Error'Identity,
+         "Empty_Interrupt_Mask unimplemented");
+   end Empty_Interrupt_Mask;
+
+   ---------------------------
+   -- Add_To_Interrupt_Mask --
+   ---------------------------
+
+   procedure Add_To_Interrupt_Mask
+     (Mask      : access Interrupt_Mask;
+      Interrupt : Interrupt_ID)
+   is
+      pragma Unreferenced (Mask, Interrupt);
+   begin
+      Raise_Exception
+        (Program_Error'Identity,
+         "Add_To_Interrupt_Mask unimplemented");
+   end Add_To_Interrupt_Mask;
+
+   --------------------------------
+   -- Delete_From_Interrupt_Mask --
+   --------------------------------
+
+   procedure Delete_From_Interrupt_Mask
+     (Mask      : access Interrupt_Mask;
+      Interrupt : Interrupt_ID)
+   is
+      pragma Unreferenced (Mask, Interrupt);
+   begin
+      Raise_Exception
+        (Program_Error'Identity,
+         "Delete_From_Interrupt_Mask unimplemented");
+   end Delete_From_Interrupt_Mask;
+
+   ---------------
+   -- Is_Member --
+   ---------------
+
+   function Is_Member
+     (Mask      : access Interrupt_Mask;
+      Interrupt : Interrupt_ID) return Boolean
+   is
+      pragma Unreferenced (Mask, Interrupt);
+   begin
+      Raise_Exception
+        (Program_Error'Identity,
+         "Is_Member unimplemented");
+      return False;
+   end Is_Member;
+
+   -------------------------
+   -- Copy_Interrupt_Mask --
+   -------------------------
+
+   procedure Copy_Interrupt_Mask
+     (X : out Interrupt_Mask;
+      Y : Interrupt_Mask) is
+      pragma Unreferenced (X, Y);
+   begin
+      Raise_Exception
+        (Program_Error'Identity,
+         "Copy_Interrupt_Mask unimplemented");
+   end Copy_Interrupt_Mask;
+
+   ----------------------------
+   -- Interrupt_Self_Process --
+   ----------------------------
+
+   procedure Interrupt_Self_Process (Interrupt : Interrupt_ID) is
+      Result : Interfaces.C.int;
+   begin
+      Result := kill (getpid, Signal (Interrupt));
+      pragma Assert (Result = 0);
+   end Interrupt_Self_Process;
+
+   --------------------------
+   -- Setup_Interrupt_Mask --
+   --------------------------
+
+   procedure Setup_Interrupt_Mask is
+   begin
+      Raise_Exception
+        (Program_Error'Identity,
+         "Setup_Interrupt_Mask unimplemented");
+   end Setup_Interrupt_Mask;
+
+end System.Interrupt_Management.Operations;

gcc/ada/s-intman-vxworks.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL is 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,8 @@
 
 --  This is the VxWorks version of this package
 
---  Make a careful study of all signals available under the OS, to see which
---  need to be reserved, kept always unmasked, or kept always unmasked. Be on
---  the lookout for special signals that may be used by the thread library.
+--  It is simpler than other versions because the Ada interrupt handling
+--  mechanisms are used for hardware interrupts rather than signals.
 
 package body System.Interrupt_Management is
 
@@ -45,15 +44,21 @@ package body System.Interrupt_Management is
                          (SIGFPE, SIGILL, SIGSEGV, SIGBUS);
 
    Exception_Action : aliased struct_sigaction;
-   --  Keep this variable global so that it is initialized only once
+   --  Keep this a variable global so that it is initialized only once
+
+   Signal_Mask : aliased sigset_t;
+   pragma Import (C, Signal_Mask, "__gnat_signal_mask");
+   --  Mask indicating that all exception signals are to be masked
+   --  when a signal is propagated.
 
    procedure Notify_Exception
      (signo      : Signal;
       siginfo    : System.Address;
       sigcontext : System.Address);
    pragma Import (C, Notify_Exception, "__gnat_error_handler");
-   --  Map signal to Ada exception and raise it.  Different versions
-   --  of VxWorks need different mappings.
+   --  Map a signal to Ada exception and raise it.  Different versions
+   --  of VxWorks need different mappings. This is addressed in init.c in
+   --  __gnat_map_signal.
 
    -----------------------
    -- Local Subprograms --
@@ -62,7 +67,7 @@ package body System.Interrupt_Management is
    function State (Int : Interrupt_ID) return Character;
    pragma Import (C, State, "__gnat_get_interrupt_state");
    --  Get interrupt state. Defined in init.c The input argument is the
-   --  interrupt number, and the result is one of the following:
+   --  hardware interrupt number, and the result is one of the following:
 
    Runtime : constant Character := 'r';
    Default : constant Character := 's';
@@ -100,8 +105,6 @@ package body System.Interrupt_Management is
    --  Set to True once Initialize is called, further calls have no effect
 
    procedure Initialize is
-      mask   : aliased sigset_t;
-      Result : int;
 
    begin
       if Initialized then
@@ -115,17 +118,11 @@ package body System.Interrupt_Management is
 
       Abort_Task_Interrupt := SIGABRT;
 
+      --  Signal_Mask was initialized in __gnat_install_handler
+
       Exception_Action.sa_handler := Notify_Exception'Address;
       Exception_Action.sa_flags := SA_ONSTACK + SA_SIGINFO;
-      Result := sigemptyset (mask'Access);
-      pragma Assert (Result = 0);
-
-      for J in Exception_Signals'Range loop
-         Result := sigaddset (mask'Access, Signal (Exception_Signals (J)));
-         pragma Assert (Result = 0);
-      end loop;
-
-      Exception_Action.sa_mask := mask;
+      Exception_Action.sa_mask := Signal_Mask;
 
       --  Initialize hardware interrupt handling
 
@@ -139,15 +136,6 @@ package body System.Interrupt_Management is
          end if;
       end loop;
 
-      --  Add exception signals to the set of unmasked signals
-
-      for J in Exception_Signals'Range loop
-         Keep_Unmasked (Exception_Signals (J)) := True;
-      end loop;
-
-      --  The abort signal must also be unmasked
-
-      Keep_Unmasked (Abort_Task_Interrupt) := True;
    end Initialize;
 
 end System.Interrupt_Management;

gcc/ada/s-intman-vxworks.ads

@@ -80,14 +80,6 @@ package System.Interrupt_Management is
    --  The signal that is used to implement task abort if an interrupt is used
    --  for that purpose. This is one of the reserved signals.
 
-   Keep_Unmasked : Signal_Set := (others => False);
-   --  Keep_Unmasked (I) is true iff the signal I is one that must that must
-   --  be kept unmasked at all times, except (perhaps) for short critical
-   --  sections. This includes signals that are mapped to exceptions, but may
-   --  also include interrupts (e.g. timer) that need to be kept unmasked for
-   --  other reasons. Where signal masking is per-task, the signal should be
-   --  unmasked in ALL TASKS.
-
    Reserve : Interrupt_Set := (others => False);
    --  Reserve (I) is true iff the interrupt I is one that cannot be permitted
    --  to be attached to a user handler. The possible reasons are many. For

gcc/ada/s-taprop-vxworks.adb

@@ -78,40 +78,34 @@ package body System.Task_Primitives.Operations is
    --  The followings are logically constants, but need to be initialized at
    --  run time.
 
-   Single_RTS_Lock : aliased RTS_Lock;
-   --  This is a lock to allow only one thread of control in the RTS at a
-   --  time; it is used to execute in mutual exclusion from all other tasks.
-   --  Used mainly in Single_Lock mode, but also to protect All_Tasks_List
-
    Environment_Task_Id : Task_Id;
    --  A variable to hold Task_Id for the environment task
 
-   Unblocked_Signal_Mask : aliased sigset_t;
-   --  The set of signals that should unblocked in all tasks
-
    --  The followings are internal configuration constants needed
 
-   Time_Slice_Val : Integer;
-   pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
+   Dispatching_Policy : Character;
+   pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
+
+   Foreign_Task_Elaborated : aliased Boolean := True;
+   --  Used to identified fake tasks (i.e., non-Ada Threads)
 
    Locking_Policy : Character;
    pragma Import (C, Locking_Policy, "__gl_locking_policy");
 
-   Dispatching_Policy : Character;
-   pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
-
    Mutex_Protocol : Priority_Type;
 
-   Foreign_Task_Elaborated : aliased Boolean := True;
-   --  Used to identified fake tasks (i.e., non-Ada Threads)
+   Signal_Mask : aliased sigset_t;
+   pragma Import (C, Signal_Mask, "__gnat_signal_mask");
+   --  Mask indicating that all exception signals are to be masked
+   --  when a signal is propagated.
 
-   type Set_Stack_Limit_Proc_Acc is access procedure;
-   pragma Convention (C, Set_Stack_Limit_Proc_Acc);
+   Single_RTS_Lock : aliased RTS_Lock;
+   --  This is a lock to allow only one thread of control in the RTS at a
+   --  time; it is used to execute in mutual exclusion from all other tasks.
+   --  Used mainly in Single_Lock mode, but also to protect All_Tasks_List
 
-   Set_Stack_Limit_Hook : Set_Stack_Limit_Proc_Acc;
-   pragma Import (C, Set_Stack_Limit_Hook, "__gnat_set_stack_limit_hook");
-   --  Procedure to be called when a task is created to set stack
-   --  limit.
+   Time_Slice_Val : Integer;
+   pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
 
    --------------------
    -- Local Packages --
@@ -168,6 +162,14 @@ package body System.Task_Primitives.Operations is
    --  This function returns True if the current execution is in the context
    --  of a task, and False if it is an interrupt context.
 
+   type Set_Stack_Limit_Proc_Acc is access procedure;
+   pragma Convention (C, Set_Stack_Limit_Proc_Acc);
+
+   Set_Stack_Limit_Hook : Set_Stack_Limit_Proc_Acc;
+   pragma Import (C, Set_Stack_Limit_Hook, "__gnat_set_stack_limit_hook");
+   --  Procedure to be called when a task is created to set stack
+   --  limit. Used only for VxWorks 5 and VxWorks MILS guest OS.
+
    function To_Address is
      new Ada.Unchecked_Conversion (Task_Id, System.Address);
 
@@ -180,7 +182,6 @@ package body System.Task_Primitives.Operations is
 
       Self_ID : constant Task_Id := Self;
       Old_Set : aliased sigset_t;
-
       Result : int;
       pragma Warnings (Off, Result);
 
@@ -198,12 +199,12 @@ package body System.Task_Primitives.Operations is
       then
          Self_ID.Aborting := True;
 
-         --  Make sure signals used for RTS internal purpose are unmasked
+         --  Make sure signals used for RTS internal purposes are unmasked
 
          Result :=
            pthread_sigmask
              (SIG_UNBLOCK,
-              Unblocked_Signal_Mask'Access,
+              Signal_Mask'Access,
               Old_Set'Access);
          pragma Assert (Result = 0);
 
@@ -1380,16 +1381,6 @@ package body System.Task_Primitives.Operations is
 
       end if;
 
-      Result := sigemptyset (Unblocked_Signal_Mask'Access);
-      pragma Assert (Result = 0);
-
-      for J in Interrupt_Management.Signal_ID loop
-         if System.Interrupt_Management.Keep_Unmasked (J) then
-            Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
-            pragma Assert (Result = 0);
-         end if;
-      end loop;
-
       --  Initialize the lock used to synchronize chain of all ATCBs
 
       Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);

gcc/ada/sem_ch6.adb

@@ -128,6 +128,9 @@ package body Sem_Ch6 is
    --  If proper warnings are enabled and the subprogram contains a construct
    --  that cannot be inlined, the offending construct is flagged accordingly.
 
+   function Can_Override_Operator (Subp : Entity_Id) return Boolean;
+   --  Returns true if Subp can override a predefined operator.
+
    procedure Check_Conformance
      (New_Id                   : Entity_Id;
       Old_Id                   : Entity_Id;
@@ -2099,11 +2102,19 @@ package body Sem_Ch6 is
                   Body_Spec);
             end if;
 
-         elsif Style_Check --  ??? incorrect use of Style_Check!
+         elsif Style_Check
            and then Present (Overridden_Operation (Spec_Id))
          then
             pragma Assert (Unit_Declaration_Node (Body_Id) = N);
             Style.Missing_Overriding (N, Body_Id);
+
+         elsif Style_Check
+           and then Can_Override_Operator (Spec_Id)
+           and then not Is_Predefined_File_Name
+                          (Unit_File_Name (Get_Source_Unit (Spec_Id)))
+         then
+            pragma Assert (Unit_Declaration_Node (Body_Id) = N);
+            Style.Missing_Overriding (N, Body_Id);
          end if;
       end Verify_Overriding_Indicator;
 
@@ -4854,61 +4865,50 @@ package body Sem_Ch6 is
       --  explicit overridden operation.
 
       elsif Nkind (Subp) = N_Defining_Operator_Symbol then
-         declare
-            Typ : constant Entity_Id :=
-                    Base_Type (Etype (First_Formal (Subp)));
-
-            Can_Override : constant Boolean :=
-                             Operator_Matches_Spec (Subp, Subp)
-                               and then Scope (Subp) = Scope (Typ)
-                               and then not Is_Class_Wide_Type (Typ);
+         if Must_Not_Override (Spec) then
 
-         begin
-            if Must_Not_Override (Spec) then
+            --  If this is not a primitive or a protected subprogram, then
+            --  "not overriding" is illegal.
 
-               --  If this is not a primitive or a protected subprogram, then
-               --  "not overriding" is illegal.
+            if not Is_Primitive
+              and then Ekind (Scope (Subp)) /= E_Protected_Type
+            then
+               Error_Msg_N
+                 ("overriding indicator only allowed "
+                  & "if subprogram is primitive", Subp);
 
-               if not Is_Primitive
-                 and then Ekind (Scope (Subp)) /= E_Protected_Type
-               then
-                  Error_Msg_N
-                    ("overriding indicator only allowed "
-                     & "if subprogram is primitive", Subp);
+            elsif Can_Override_Operator (Subp) then
+               Error_Msg_NE
+                 ("subprogram& overrides predefined operator ", Spec, Subp);
+            end if;
 
-               elsif Can_Override then
-                  Error_Msg_NE
-                    ("subprogram& overrides predefined operator ", Spec, Subp);
-               end if;
+         elsif Must_Override (Spec) then
+            if No (Overridden_Operation (Subp))
+              and then not Can_Override_Operator (Subp)
+            then
+               Error_Msg_NE ("subprogram & is not overriding", Spec, Subp);
+            end if;
 
-            elsif Must_Override (Spec) then
-               if No (Overridden_Operation (Subp))
-                 and then not Can_Override
-               then
-                  Error_Msg_NE ("subprogram & is not overriding", Spec, Subp);
-               end if;
+         elsif not Error_Posted (Subp)
+           and then Style_Check
+           and then Can_Override_Operator (Subp)
+           and then
+             not Is_Predefined_File_Name
+                   (Unit_File_Name (Get_Source_Unit (Subp)))
+         then
+            --  If style checks are enabled, indicate that the indicator is
+            --  missing. However, at the point of declaration, the type of
+            --  which this is a primitive operation may be private, in which
+            --  case the indicator would be premature.
 
-            elsif not Error_Posted (Subp)
-              and then Style_Check
-              and then Can_Override
-              and then
-                not Is_Predefined_File_Name
-                      (Unit_File_Name (Get_Source_Unit (Subp)))
+            if Has_Private_Declaration (Etype (Subp))
+              or else Has_Private_Declaration (Etype (First_Formal (Subp)))
             then
-               --  If style checks are enabled, indicate that the indicator is
-               --  missing. However, at the point of declaration, the type of
-               --  which this is a primitive operation may be private, in which
-               --  case the indicator would be premature.
-
-               if Has_Private_Declaration (Etype (Subp))
-                 or else Has_Private_Declaration (Etype (First_Formal (Subp)))
-               then
-                  null;
-               else
-                  Style.Missing_Overriding (Decl, Subp);
-               end if;
+               null;
+            else
+               Style.Missing_Overriding (Decl, Subp);
             end if;
-         end;
+         end if;
 
       elsif Must_Override (Spec) then
          if Ekind (Subp) = E_Entry then
@@ -5442,6 +5442,25 @@ package body Sem_Ch6 is
         (New_Id, Old_Id, Type_Conformant, True, Result, Err_Loc);
    end Check_Type_Conformant;
 
+   ---------------------------
+   -- Can_Override_Operator --
+   ---------------------------
+
+   function Can_Override_Operator (Subp : Entity_Id) return Boolean is
+      Typ : Entity_Id;
+   begin
+      if Nkind (Subp) /= N_Defining_Operator_Symbol then
+         return False;
+
+      else
+         Typ := Base_Type (Etype (First_Formal (Subp)));
+
+         return Operator_Matches_Spec (Subp, Subp)
+           and then Scope (Subp) = Scope (Typ)
+           and then not Is_Class_Wide_Type (Typ);
+      end if;
+   end Can_Override_Operator;
+
    ----------------------
    -- Conforming_Types --
    ----------------------

gcc/ada/sem_ch8.adb

@@ -2683,12 +2683,24 @@ package body Sem_Ch8 is
       --  been analyzed previously, and it is begin reinstalled, for example
       --  when the clause appears in a package spec and we are compiling the
       --  corresponding package body. In that case, make the entities on the
-      --  existing list use-visible.
+      --  existing list use_visible, and mark the corresponding types In_Use.
 
       if Present (Used_Operations (N)) then
          declare
+            Mark : Node_Id;
             Elmt : Elmt_Id;
+
          begin
+            Mark := First (Subtype_Marks (N));
+            while Present (Mark) loop
+               if not In_Use (Entity (Mark))
+                 and then not Is_Potentially_Use_Visible (Entity (Mark))
+               then
+                  Set_In_Use (Base_Type (Entity (Mark)));
+               end if;
+               Next (Mark);
+            end loop;
+
             Elmt := First_Elmt (Used_Operations (N));
             while Present (Elmt) loop
                Set_Is_Potentially_Use_Visible (Node (Elmt));

gcc/ada/sem_res.adb

@@ -5648,10 +5648,14 @@ package body Sem_Res is
          Check_Potentially_Blocking_Operation (N);
       end if;
 
-      --  A call to Ada.Real_Time.Timing_Events.Set_Handler violates
-      --  restriction No_Relative_Delay (AI-0211).
+      --  A call to Ada.Real_Time.Timing_Events.Set_Handler to set a relative
+      --  timing event violates restriction No_Relative_Delay (AI-0211). We
+      --  need to check the second argument to determine whether it is an
+      --  absolute or relative timing event.
 
-      if Is_RTE (Nam, RE_Set_Handler) then
+      if Is_RTE (Nam, RE_Set_Handler)
+        and then Is_RTE (Etype (Next_Actual (First_Actual (N))), RE_Time_Span)
+      then
          Check_Restriction (No_Relative_Delay, N);
       end if;