------------------------------------------------------------------------------
-- --
--- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
+-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . I N T E R R U P T S --
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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- --
-- 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, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- 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, --
-- Invariants:
--- All user-handleable signals are masked at all times in all
--- tasks/threads except possibly for the Interrupt_Manager task.
+-- All user-handleable signals are masked at all times in all tasks/threads
+-- except possibly for the Interrupt_Manager task.
--- When a user task wants to have the effect of masking/unmasking an
--- signal, it must call Block_Interrupt/Unblock_Interrupt, which
--- will have the effect of unmasking/masking the signal in the
--- Interrupt_Manager task. These comments do not apply to vectored
--- hardware interrupts, which may be masked or unmasked using routined
--- interfaced to the relevant VxWorks system calls.
+-- When a user task wants to have the effect of masking/unmasking an signal,
+-- it must call Block_Interrupt/Unblock_Interrupt, which will have the effect
+-- of unmasking/masking the signal in the Interrupt_Manager task. These
+-- comments do not apply to vectored hardware interrupts, which may be masked
+-- or unmasked using routined interfaced to the relevant VxWorks system
+-- calls.
--- Once we associate a Signal_Server_Task with an signal, the task never
--- goes away, and we never remove the association. On the other hand, it
--- is more convenient to terminate an associated Interrupt_Server_Task
--- for a vectored hardware interrupt (since we use a binary semaphore
--- for synchronization with the umbrella handler).
+-- Once we associate a Signal_Server_Task with an signal, the task never goes
+-- away, and we never remove the association. On the other hand, it is more
+-- convenient to terminate an associated Interrupt_Server_Task for a vectored
+-- hardware interrupt (since we use a binary semaphore for synchronization
+-- with the umbrella handler).
-- There is no more than one signal per Signal_Server_Task and no more than
--- one Signal_Server_Task per signal. The same relation holds for hardware
--- interrupts and Interrupt_Server_Task's at any given time. That is,
--- only one non-terminated Interrupt_Server_Task exists for a give
--- interrupt at any time.
+-- one Signal_Server_Task per signal. The same relation holds for hardware
+-- interrupts and Interrupt_Server_Task's at any given time. That is, only
+-- one non-terminated Interrupt_Server_Task exists for a give interrupt at
+-- any time.
-- Within this package, the lock L is used to protect the various status
--- tables. If there is a Server_Task associated with a signal or interrupt,
--- we use the per-task lock of the Server_Task instead so that we protect the
--- status between Interrupt_Manager and Server_Task. Protection among
--- service requests are ensured via user calls to the Interrupt_Manager
--- entries.
+-- tables. If there is a Server_Task associated with a signal or interrupt, we
+-- use the per-task lock of the Server_Task instead so that we protect the
+-- status between Interrupt_Manager and Server_Task. Protection among service
+-- requests are ensured via user calls to the Interrupt_Manager entries.
-- This is the VxWorks version of this package, supporting vectored hardware
-- interrupts.
-with Unchecked_Conversion;
-
-with System.OS_Interface; use System.OS_Interface;
-
-with Interfaces.VxWorks;
-
+with Ada.Unchecked_Conversion;
with Ada.Task_Identification;
--- used for Task_ID type
-with Ada.Exceptions;
--- used for Raise_Exception
+with Interfaces.VxWorks;
+with System.OS_Interface; use System.OS_Interface;
with System.Interrupt_Management;
--- used for Reserve
-
with System.Task_Primitives.Operations;
--- used for Write_Lock
--- Unlock
--- Abort
--- Wakeup_Task
--- Sleep
--- Initialize_Lock
-
with System.Storage_Elements;
--- used for To_Address
--- To_Integer
--- Integer_Address
-
-with System.Tasking;
--- used for Task_ID
--- Task_Entry_Index
--- Null_Task
--- Self
--- Interrupt_Manager_ID
-
with System.Tasking.Utilities;
--- used for Make_Independent
with System.Tasking.Rendezvous;
--- used for Call_Simple
pragma Elaborate_All (System.Tasking.Rendezvous);
package body System.Interrupts is
use Tasking;
- use Ada.Exceptions;
package POP renames System.Task_Primitives.Operations;
- function To_Ada is new Unchecked_Conversion
- (System.Tasking.Task_ID, Ada.Task_Identification.Task_Id);
+ function To_Ada is new Ada.Unchecked_Conversion
+ (System.Tasking.Task_Id, Ada.Task_Identification.Task_Id);
- function To_System is new Unchecked_Conversion
- (Ada.Task_Identification.Task_Id, Task_ID);
+ function To_System is new Ada.Unchecked_Conversion
+ (Ada.Task_Identification.Task_Id, Task_Id);
-----------------
-- Local Tasks --
-----------------
- -- WARNING: System.Tasking.Stages performs calls to this task
- -- with low-level constructs. Do not change this spec without synchro-
- -- nizing it.
+ -- WARNING: System.Tasking.Stages performs calls to this task with
+ -- low-level constructs. Do not change this spec without synchronizing it.
task Interrupt_Manager is
- entry Detach_Interrupt_Entries (T : Task_ID);
+ entry Detach_Interrupt_Entries (T : Task_Id);
entry Attach_Handler
(New_Handler : Parameterless_Handler;
Static : Boolean);
entry Bind_Interrupt_To_Entry
- (T : Task_ID;
+ (T : Task_Id;
E : Task_Entry_Index;
Interrupt : Interrupt_ID);
-------------------------------
type Entry_Assoc is record
- T : Task_ID;
+ T : Task_Id;
E : Task_Entry_Index;
end record;
Registered_Handler_Head : R_Link := null;
Registered_Handler_Tail : R_Link := null;
- Server_ID : array (Interrupt_ID) of System.Tasking.Task_ID :=
+ Server_ID : array (Interrupt_ID) of System.Tasking.Task_Id :=
(others => System.Tasking.Null_Task);
pragma Atomic_Components (Server_ID);
- -- Holds the Task_ID of the Server_Task for each interrupt / signal.
- -- Task_ID is needed to accomplish locking per interrupt base. Also
+ -- Holds the Task_Id of the Server_Task for each interrupt / signal.
+ -- Task_Id is needed to accomplish locking per interrupt base. Also
-- is needed to determine whether to create a new Server_Task.
Semaphore_ID_Map : array
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 --
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);
-- already bound.
procedure Bind_Interrupt_To_Entry
- (T : Task_ID;
+ (T : Task_Id;
E : Task_Entry_Index;
Int_Ref : System.Address)
is
procedure Check_Reserved_Interrupt (Interrupt : Interrupt_ID) is
begin
if Is_Reserved (Interrupt) then
- Raise_Exception
- (Program_Error'Identity,
- "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved");
+ raise Program_Error with
+ "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
else
return;
end if;
---------------------
function Current_Handler
- (Interrupt : Interrupt_ID) return Parameterless_Handler is
+ (Interrupt : Interrupt_ID) return Parameterless_Handler
+ is
begin
Check_Reserved_Interrupt (Interrupt);
-- Detach_Interrupt_Entries --
------------------------------
- procedure Detach_Interrupt_Entries (T : Task_ID) is
+ procedure Detach_Interrupt_Entries (T : Task_Id) is
begin
Interrupt_Manager.Detach_Interrupt_Entries (T);
end Detach_Interrupt_Entries;
(Old_Handler : out Parameterless_Handler;
New_Handler : Parameterless_Handler;
Interrupt : Interrupt_ID;
- Static : Boolean := False) is
+ Static : Boolean := False)
+ is
begin
Check_Reserved_Interrupt (Interrupt);
Interrupt_Manager.Exchange_Handler
-- Finalize_Interrupt_Servers --
--------------------------------
- -- Restore default handlers for interrupt servers.
+ -- Restore default handlers for interrupt servers
-- This is called by the Interrupt_Manager task when it receives the abort
-- signal during program finalization.
return Boolean
is
pragma Unreferenced (Object);
-
begin
return True;
end Has_Interrupt_Or_Attach_Handler;
return Boolean
is
pragma Unreferenced (Object);
-
begin
return True;
end Has_Interrupt_Or_Attach_Handler;
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 --
----------------------
procedure Install_Handlers
(Object : access Static_Interrupt_Protection;
- New_Handlers : New_Handler_Array) is
+ New_Handlers : New_Handler_Array)
+ is
begin
for N in New_Handlers'Range loop
+
-- We need a lock around this ???
Object.Previous_Handlers (N).Interrupt := New_Handlers (N).Interrupt;
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 --
------------------------------
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?
-- 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;
Handler_Addr : System.Address;
end record;
- function To_Fat_Ptr is new Unchecked_Conversion
+ function To_Fat_Ptr is new Ada.Unchecked_Conversion
(Parameterless_Handler, Fat_Ptr);
Ptr : R_Link;
-- 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
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;
---------------
procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is
New_Node_Ptr : R_Link;
+
begin
-- This routine registers a handler as usable for dynamic
-- interrupt handler association. Routines attaching and detaching
------------------
function Unblocked_By
- (Interrupt : Interrupt_ID) return System.Tasking.Task_ID is
+ (Interrupt : Interrupt_ID) return System.Tasking.Task_Id
+ is
begin
Unimplemented ("Unblocked_By");
return Null_Task;
procedure Unimplemented (Feature : String) is
begin
- Raise_Exception
- (Program_Error'Identity,
- Feature & " not implemented on VxWorks");
+ raise Program_Error with Feature & " not implemented on VxWorks";
end Unimplemented;
-----------------------
use type STATUS;
begin
- -- Hardware interrupt
-
- Install_Default_Action (HW_Interrupt (Interrupt));
-- Flush server task off semaphore, allowing it to terminate
-- If an interrupt entry is installed raise
-- Program_Error. (propagate it to the caller).
- Raise_Exception (Program_Error'Identity,
- "An interrupt entry is already installed");
+ raise Program_Error with
+ "An interrupt entry is already installed";
end if;
-- Note : Static = True will pass the following check. This is the
-- status of the Current_Handler.
if not Static and then User_Handler (Interrupt).Static then
- -- Trying to detach a static Interrupt Handler.
- -- raise Program_Error.
- Raise_Exception (Program_Error'Identity,
- "Trying to detach a static Interrupt Handler");
+ -- Trying to detach a static Interrupt Handler. raise
+ -- Program_Error.
+
+ raise Program_Error with
+ "Trying to detach a static Interrupt Handler";
end if;
Old_Handler := User_Handler (Interrupt).H;
New_Handler : Parameterless_Handler;
Interrupt : Interrupt_ID;
Static : Boolean;
- Restoration : Boolean := False) is
+ Restoration : Boolean := False)
+ is
begin
if User_Entry (Interrupt).T /= Null_Task then
+
-- If an interrupt entry is already installed, raise
-- Program_Error. (propagate it to the caller).
- Raise_Exception
- (Program_Error'Identity,
- "An interrupt is already installed");
+ raise Program_Error with "An interrupt is already installed";
end if;
-- Note : A null handler with Static = True will
or else not Is_Registered (New_Handler))
then
- Raise_Exception
- (Program_Error'Identity,
+ raise Program_Error with
"Trying to overwrite a static Interrupt Handler with a " &
- "dynamic Handler");
+ "dynamic Handler";
end if;
-- Save the old handler
if New_Handler = null then
- -- The null handler means we are detaching the handler.
+ -- The null handler means we are detaching the handler
User_Handler (Interrupt).Static := False;
end if;
-- Invoke a corresponding Server_Task if not yet created.
- -- Place Task_ID info in Server_ID array.
+ -- Place Task_Id info in Server_ID array.
if New_Handler /= null
and then
end if;
if (New_Handler = null) and then Old_Handler /= null then
+
-- Restore default handler
Unbind_Handler (Interrupt);
elsif Old_Handler = null then
+
-- Save default handler
Bind_Handler (Interrupt);
end Detach_Handler;
or
accept Bind_Interrupt_To_Entry
- (T : Task_ID;
+ (T : Task_Id;
E : Task_Entry_Index;
Interrupt : Interrupt_ID)
do
if User_Handler (Interrupt).H /= null
or else User_Entry (Interrupt).T /= Null_Task
then
- Raise_Exception
- (Program_Error'Identity,
- "A binding for this interrupt is already present");
+ raise Program_Error with
+ "A binding for this interrupt is already present";
end if;
User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E);
T.Interrupt_Entry := True;
-- Invoke a corresponding Server_Task if not yet created.
- -- Place Task_ID info in Server_ID array.
+ -- Place Task_Id info in Server_ID array.
if Server_ID (Interrupt) = Null_Task
or else
end Bind_Interrupt_To_Entry;
or
- accept Detach_Interrupt_Entries (T : Task_ID) do
+ accept Detach_Interrupt_Entries (T : Task_Id) do
for Int in Interrupt_ID'Range loop
if not Is_Reserved (Int) then
if User_Entry (Int).T = T then
end if;
end loop;
- -- Indicate in ATCB that no interrupt entries are attached.
+ -- Indicate in ATCB that no interrupt entries are attached
T.Interrupt_Entry := False;
end Detach_Interrupt_Entries;
-- Server task for vectored hardware interrupt handling
task body Interrupt_Server_Task is
- Self_Id : constant Task_ID := Self;
+ Self_Id : constant Task_Id := Self;
Tmp_Handler : Parameterless_Handler;
- Tmp_ID : Task_ID;
+ Tmp_ID : Task_Id;
Tmp_Entry_Index : Task_Entry_Index;
S : STATUS;
POP.Write_Lock (Self_Id);
+ -- Unassociate the interrupt handler.
+
+ Semaphore_ID_Map (Interrupt) := 0;
+
-- Delete the associated semaphore
S := semDelete (Int_Sema);
-- Set status for the Interrupt_Manager
- Semaphore_ID_Map (Interrupt) := 0;
Server_ID (Interrupt) := Null_Task;
POP.Unlock (Self_Id);
end Interrupt_Server_Task;
begin
- -- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent.
+ -- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent
Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
end System.Interrupts;
OSDN Git Service
