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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@134015 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 31 insertions, 36 deletions

diff --git a/gcc/ada/s-interr-vxworks.adb b/gcc/ada/s-interr-vxworks.adb
index ec14f11c899..fac4cfc8619 100644
--- a/gcc/ada/s-interr-vxworks.adb
+++ b/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);