2008-04-08 Jose Ruiz <ruiz@adacore.com>

	    Tristan Gingold  <gingold@adacore.com>

	* s-interr-dummy.adb, s-interr-vms.adb, s-interr-sigaction.adb
	(Install_Restricted_Handlers): New procedure
	which is a simplified version of Install_Handlers that does not store
	previously installed.

	* s-interr-vxworks.adb: Fix ACATS cxc3001
	On VxWorks interrupts can't be detached.
	(Install_Restricted_Handlers): New procedure.

	* s-interr.ads, s-interr.adb (Install_Restricted_Handlers): New
	procedure.

From-SVN: r134015

gcc/ada/s-interr-dummy.adb

@@ -7,7 +7,7 @@
 --                                  B o d y                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---                     Copyright (C) 1995-2007, AdaCore                     --
+--                     Copyright (C) 1995-2008, AdaCore                     --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -185,6 +185,15 @@ package body System.Interrupts is
       Unimplemented;
    end Install_Handlers;
 
+   ---------------------------------
+   -- Install_Restricted_Handlers --
+   ---------------------------------
+
+   procedure Install_Restricted_Handlers (Handlers : New_Handler_Array) is
+   begin
+      Unimplemented;
+   end Install_Restricted_Handlers;
+
    ----------------
    -- Is_Blocked --
    ----------------

gcc/ada/s-interr-sigaction.adb

@@ -290,6 +290,17 @@ package body System.Interrupts is
       end loop;
    end Install_Handlers;
 
+   ---------------------------------
+   -- Install_Restricted_Handlers --
+   ---------------------------------
+
+   procedure Install_Restricted_Handlers (Handlers : New_Handler_Array) is
+   begin
+      for N in Handlers'Range loop
+         Attach_Handler (Handlers (N).Handler, Handlers (N).Interrupt, True);
+      end loop;
+   end Install_Restricted_Handlers;
+
    ---------------------
    -- Current_Handler --
    ---------------------

gcc/ada/s-interr-vms.adb

@@ -736,7 +736,7 @@ package body System.Interrupts is
 
       --  Abort_Task_Interrupt is one of the Interrupt unmasked
       --  in all tasks. We mask the Interrupt in this particular task
-      --  so that "sigwait" is possible to catch an explicitely sent
+      --  so that "sigwait" is possible to catch an explicitly sent
       --  Abort_Task_Interrupt from the Server_Tasks.
 
       --  This sigwaiting is needed so that we make sure a Server_Task is
@@ -1096,6 +1096,17 @@ package body System.Interrupts is
       end loop;
    end Install_Handlers;
 
+   ---------------------------------
+   -- Install_Restricted_Handlers --
+   ---------------------------------
+
+   procedure Install_Restricted_Handlers (Handlers : New_Handler_Array) is
+   begin
+      for N in Handlers'Range loop
+         Attach_Handler (Handlers (N).Handler, Handlers (N).Interrupt, True);
+      end loop;
+   end Install_Restricted_Handlers;
+
 --  Elaboration code for package System.Interrupts
 
 begin

gcc/ada/s-interr-vxworks.adb

@@ -191,10 +191,10 @@ package body System.Interrupts is
    Interrupt_Access_Hold : Interrupt_Task_Access;
    --  Variable for allocating an Interrupt_Server_Task
 
-   Default_Handler : array (HW_Interrupt) of Interfaces.VxWorks.VOIDFUNCPTR;
-   --  Vectored interrupt handlers installed prior to program startup.
-   --  These are saved only when the umbrella handler is installed for
-   --  a given interrupt number.
+   Handler_Installed : array (HW_Interrupt) of Boolean := (others => False);
+   --  True if Notify_Interrupt was connected to the interrupt.  Handlers
+   --  can be connected but disconnection is not possible on VxWorks.
+   --  Therefore we ensure Notify_Installed is connected at most once.
 
    -----------------------
    -- Local Subprograms --
@@ -215,9 +215,6 @@ package body System.Interrupts is
    procedure Notify_Interrupt (Param : System.Address);
    --  Umbrella handler for vectored interrupts (not signals)
 
-   procedure Install_Default_Action (Interrupt : HW_Interrupt);
-   --  Restore a handler that was in place prior to program execution
-
    procedure Install_Umbrella_Handler
      (Interrupt : HW_Interrupt;
       Handler   : Interfaces.VxWorks.VOIDFUNCPTR);
@@ -448,20 +445,6 @@ package body System.Interrupts is
       Unimplemented ("Ignore_Interrupt");
    end Ignore_Interrupt;
 
-   ----------------------------
-   -- Install_Default_Action --
-   ----------------------------
-
-   procedure Install_Default_Action (Interrupt : HW_Interrupt) is
-   begin
-      --  Restore original interrupt handler
-
-      Interfaces.VxWorks.intVecSet
-        (Interfaces.VxWorks.INUM_TO_IVEC (Integer (Interrupt)),
-         Default_Handler (Interrupt));
-      Default_Handler (Interrupt) := null;
-   end Install_Default_Action;
-
    ----------------------
    -- Install_Handlers --
    ----------------------
@@ -490,6 +473,17 @@ package body System.Interrupts is
       end loop;
    end Install_Handlers;
 
+   ---------------------------------
+   -- Install_Restricted_Handlers --
+   ---------------------------------
+
+   procedure Install_Restricted_Handlers (Handlers : New_Handler_Array) is
+   begin
+      for N in Handlers'Range loop
+         Attach_Handler (Handlers (N).Handler, Handlers (N).Interrupt, True);
+      end loop;
+   end Install_Restricted_Handlers;
+
    ------------------------------
    -- Install_Umbrella_Handler --
    ------------------------------
@@ -503,10 +497,6 @@ package body System.Interrupts is
       Vec : constant Interrupt_Vector :=
               INUM_TO_IVEC (Interfaces.VxWorks.int (Interrupt));
 
-      Old_Handler : constant VOIDFUNCPTR :=
-                      intVecGet
-                        (INUM_TO_IVEC (Interfaces.VxWorks.int (Interrupt)));
-
       Stat : Interfaces.VxWorks.STATUS;
       pragma Unreferenced (Stat);
       --  ??? shouldn't we test Stat at least in a pragma Assert?
@@ -517,10 +507,9 @@ package body System.Interrupts is
       --  when an interrupt occurs, so the umbrella handler has a different
       --  wrapper generated by intConnect for each interrupt number.
 
-      if Default_Handler (Interrupt) = null then
-         Stat :=
-           intConnect (Vec, Handler, System.Address (Interrupt));
-         Default_Handler (Interrupt) := Old_Handler;
+      if not Handler_Installed (Interrupt) then
+         Stat := intConnect (Vec, Handler, System.Address (Interrupt));
+         Handler_Installed (Interrupt) := True;
       end if;
    end Install_Umbrella_Handler;
 
@@ -616,8 +605,10 @@ package body System.Interrupts is
 
    --  Umbrella handler for vectored hardware interrupts (as opposed to
    --  signals and exceptions).  As opposed to the signal implementation,
-   --  this handler is only installed in the vector table while there is
-   --  an active association of an Ada handler to the interrupt.
+   --  this handler is installed in the vector table when the first Ada
+   --  handler is attached to the interrupt.  However because VxWorks don't
+   --  support disconnecting handlers, this subprogram always test wether
+   --  or not an Ada handler is effectively attached.
 
    --  Otherwise, the handler that existed prior to program startup is
    --  in the vector table.  This ensures that handlers installed by
@@ -633,11 +624,15 @@ package body System.Interrupts is
    procedure Notify_Interrupt (Param : System.Address) is
       Interrupt : constant Interrupt_ID := Interrupt_ID (Param);
 
+      Id : constant SEM_ID := Semaphore_ID_Map (Interrupt);
+
       Discard_Result : STATUS;
       pragma Unreferenced (Discard_Result);
 
    begin
-      Discard_Result := semGive (Semaphore_ID_Map (Interrupt));
+      if Id /= 0 then
+         Discard_Result := semGive (Id);
+      end if;
    end Notify_Interrupt;
 
    ---------------
@@ -773,9 +768,6 @@ package body System.Interrupts is
          use type STATUS;
 
       begin
-         --  Hardware interrupt
-
-         Install_Default_Action (HW_Interrupt (Interrupt));
 
          --  Flush server task off semaphore, allowing it to terminate
 
@@ -1093,6 +1085,10 @@ package body System.Interrupts is
 
             POP.Write_Lock (Self_Id);
 
+            --  Unassociate the interrupt handler.
+
+            Semaphore_ID_Map (Interrupt) := 0;
+
             --  Delete the associated semaphore
 
             S := semDelete (Int_Sema);
@@ -1101,7 +1097,6 @@ package body System.Interrupts is
 
             --  Set status for the Interrupt_Manager
 
-            Semaphore_ID_Map (Interrupt) := 0;
             Server_ID (Interrupt) := Null_Task;
             POP.Unlock (Self_Id);
 

gcc/ada/s-interr.adb

@@ -451,6 +451,17 @@ package body System.Interrupts is
       end loop;
    end Install_Handlers;
 
+   ---------------------------------
+   -- Install_Restricted_Handlers --
+   ---------------------------------
+
+   procedure Install_Restricted_Handlers (Handlers : New_Handler_Array) is
+   begin
+      for N in Handlers'Range loop
+         Attach_Handler (Handlers (N).Handler, Handlers (N).Interrupt, True);
+      end loop;
+   end Install_Restricted_Handlers;
+
    ----------------
    -- Is_Blocked --
    ----------------
@@ -942,7 +953,7 @@ package body System.Interrupts is
 
       --  Abort_Task_Interrupt is one of the Interrupt unmasked
       --  in all tasks. We mask the Interrupt in this particular task
-      --  so that "sigwait" is possible to catch an explicitely sent
+      --  so that "sigwait" is possible to catch an explicitly sent
       --  Abort_Task_Interrupt from the Server_Tasks.
 
       --  This sigwaiting is needed so that we make sure a Server_Task is
@@ -1228,7 +1239,7 @@ package body System.Interrupts is
 
       --  Abort_Task_Interrupt is one of the Interrupt unmasked in all tasks.
       --  We mask the Interrupt in this particular task so that "sigwait" is
-      --  possible to catch an explicitely sent Abort_Task_Interrupt from the
+      --  possible to catch an explicitly sent Abort_Task_Interrupt from the
       --  Interrupt_Manager.
 
       --  There are two Interrupt interrupts that this task catch through
@@ -1412,7 +1423,7 @@ package body System.Interrupts is
          end if;
 
          --  Undefer abort here to allow a window for this task to be aborted
-         --  at the time of system shutdown. We also explicitely test for
+         --  at the time of system shutdown. We also explicitly test for
          --  Pending_Action in case System.Parameters.No_Abort is True.
 
       end loop;

gcc/ada/s-interr.ads

@@ -268,4 +268,11 @@ package System.Interrupts is
    --  Store the old handlers in Object.Previous_Handlers and install
    --  the new static handlers.
 
+   procedure Install_Restricted_Handlers (Handlers : New_Handler_Array);
+   --  Install the static Handlers for the given interrupts and do not store
+   --  previously installed handlers. This procedure is used when the Ravenscar
+   --  restrictions are in place since in that case there are only
+   --  library-level protected handlers that will be installed at
+   --  initialization and never be replaced.
+
 end System.Interrupts;