From: Jose Ruiz Date: Tue, 8 Apr 2008 06:46:28 +0000 (+0200) Subject: 2008-04-08 Jose Ruiz X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c54ec67ce7019a0f5212ca95054cfe972c587b21;p=gcc.git 2008-04-08 Jose Ruiz Tristan Gingold * 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 --- diff --git a/gcc/ada/s-interr-dummy.adb b/gcc/ada/s-interr-dummy.adb index 075c8b5755c..343f8f559f1 100644 --- a/gcc/ada/s-interr-dummy.adb +++ b/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 -- ---------------- diff --git a/gcc/ada/s-interr-sigaction.adb b/gcc/ada/s-interr-sigaction.adb index a63b35aaaa3..14bb9707fec 100644 --- a/gcc/ada/s-interr-sigaction.adb +++ b/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 -- --------------------- diff --git a/gcc/ada/s-interr-vms.adb b/gcc/ada/s-interr-vms.adb index 3a7124025c2..2711e036cbe 100644 --- a/gcc/ada/s-interr-vms.adb +++ b/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 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); diff --git a/gcc/ada/s-interr.adb b/gcc/ada/s-interr.adb index 7b4175eab59..3fe420303a6 100644 --- a/gcc/ada/s-interr.adb +++ b/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; diff --git a/gcc/ada/s-interr.ads b/gcc/ada/s-interr.ads index 1eecfdb9af9..022d05471a3 100644 --- a/gcc/ada/s-interr.ads +++ b/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;