OSDN Git Service

2008-04-08 Ed Schonberg <schonberg@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / s-interr-vms.adb
index f302ead..2711e03 100644 (file)
@@ -1,12 +1,12 @@
 ------------------------------------------------------------------------------
 --                                                                          --
---                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- --
@@ -16,8 +16,8 @@
 -- 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, --
@@ -31,7 +31,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This is an OpenVMS/Alpha version of this package.
+--  This is an OpenVMS/Alpha version of this package
 
 --  Invariants:
 
 --  rendezvous.
 
 with Ada.Task_Identification;
---  used for Task_ID type
-
-with Ada.Exceptions;
---  used for Raise_Exception
+with Ada.Unchecked_Conversion;
 
 with System.Task_Primitives;
---  used for RTS_Lock
---           Self
-
 with System.Interrupt_Management;
---  used for Reserve
---           Interrupt_ID
---           Interrupt_Mask
---           Abort_Task_Interrupt
 
 with System.Interrupt_Management.Operations;
---  used for Thread_Block_Interrupt
---           Thread_Unblock_Interrupt
---           Install_Default_Action
---           Install_Ignore_Action
---           Copy_Interrupt_Mask
---           Set_Interrupt_Mask
---           Empty_Interrupt_Mask
---           Fill_Interrupt_Mask
---           Add_To_Interrupt_Mask
---           Delete_From_Interrupt_Mask
---           Interrupt_Wait
---           Interrupt_Self_Process
---           Get_Interrupt_Mask
---           Set_Interrupt_Mask
---           IS_Member
---           Environment_Mask
 pragma Elaborate_All (System.Interrupt_Management.Operations);
 
 with System.Task_Primitives.Operations;
---  used for Write_Lock
---           Unlock
---           Abort
---           Wakeup_Task
---           Sleep
---           Initialize_Lock
-
 with System.Task_Primitives.Interrupt_Operations;
---  used for Set_Interrupt_ID
-
 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);
 
 with System.Tasking.Initialization;
---  used for Defer_Abort
---           Undefer_Abort
-
 with System.Parameters;
---  used for Single_Lock
-
-with Unchecked_Conversion;
 
 package body System.Interrupts is
 
    use Tasking;
    use System.Parameters;
-   use Ada.Exceptions;
 
    package POP renames System.Task_Primitives.Operations;
    package PIO renames System.Task_Primitives.Interrupt_Operations;
    package IMNG renames System.Interrupt_Management;
    package IMOP renames System.Interrupt_Management.Operations;
 
-   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 Initialize (Mask : IMNG.Interrupt_Mask);
 
@@ -166,7 +110,7 @@ package body System.Interrupts is
          Static      : Boolean);
 
       entry Bind_Interrupt_To_Entry
-        (T         : Task_ID;
+        (T         : Task_Id;
          E         : Task_Entry_Index;
          Interrupt : Interrupt_ID);
 
@@ -183,21 +127,21 @@ package body System.Interrupts is
 
    task type Server_Task (Interrupt : Interrupt_ID) is
       pragma Priority (System.Interrupt_Priority'Last);
-      --  Note: the above pragma Priority is strictly speaking improper
-      --  since it is outside the range of allowed priorities, but the
-      --  compiler treats system units specially and does not apply
-      --  this range checking rule to system units.
+      --  Note: the above pragma Priority is strictly speaking improper since
+      --  it is outside the range of allowed priorities, but the compiler
+      --  treats system units specially and does not apply this range checking
+      --  rule to system units.
 
    end Server_Task;
 
    type Server_Task_Access is access Server_Task;
 
-   --------------------------------
-   --  Local Types and Variables --
-   --------------------------------
+   -------------------------------
+   -- Local Types and Variables --
+   -------------------------------
 
    type Entry_Assoc is record
-      T : Task_ID;
+      T : Task_Id;
       E : Task_Entry_Index;
    end record;
 
@@ -210,9 +154,9 @@ package body System.Interrupts is
                     (others => (null, Static => False));
    pragma Volatile_Components (User_Handler);
    --  Holds the protected procedure handler (if any) and its Static
-   --  information  for each interrupt. A handler is a Static one if
-   --  it is specified through the pragma Attach_Handler.
-   --  Attach_Handler. Otherwise, not static)
+   --  information for each interrupt. A handler is a Static one if it is
+   --  specified through the pragma Attach_Handler. Attach_Handler. Otherwise,
+   --  not static)
 
    User_Entry : array (Interrupt_ID'Range) of Entry_Assoc :=
                   (others => (T => Null_Task, E => Null_Task_Entry));
@@ -221,30 +165,30 @@ package body System.Interrupts is
 
    Blocked : constant array (Interrupt_ID'Range) of Boolean :=
      (others => False);
---  ??? pragma Volatile_Components (Blocked);
+   --  ??? pragma Volatile_Components (Blocked);
    --  True iff the corresponding interrupt is blocked in the process level
 
    Ignored : array (Interrupt_ID'Range) of Boolean := (others => False);
    pragma Volatile_Components (Ignored);
    --  True iff the corresponding interrupt is blocked in the process level
 
-   Last_Unblocker : constant array (Interrupt_ID'Range) of Task_ID :=
+   Last_Unblocker : constant array (Interrupt_ID'Range) of Task_Id :=
      (others => Null_Task);
 --  ??? pragma Volatile_Components (Last_Unblocker);
    --  Holds the ID of the last Task which Unblocked this Interrupt.
    --  It contains Null_Task if no tasks have ever requested the
    --  Unblocking operation or the Interrupt is currently Blocked.
 
-   Server_ID : array (Interrupt_ID'Range) of Task_ID :=
+   Server_ID : array (Interrupt_ID'Range) of Task_Id :=
                  (others => Null_Task);
    pragma Atomic_Components (Server_ID);
-   --  Holds the Task_ID of the Server_Task for each interrupt.
-   --  Task_ID is needed to accomplish locking per Interrupt base. Also
-   --  is needed to decide whether to create a new Server_Task.
+   --  Holds the Task_Id of the Server_Task for each interrupt. Task_Id is
+   --  needed to accomplish locking per Interrupt base. Also is needed to
+   --  decide whether to create a new Server_Task.
 
    --  Type and Head, Tail of the list containing Registered Interrupt
-   --  Handlers. These definitions are used to register the handlers
-   --  specified by the pragma Interrupt_Handler.
+   --  Handlers. These definitions are used to register the handlers specified
+   --  by the pragma Interrupt_Handler.
 
    type Registered_Handler;
    type R_Link is access all Registered_Handler;
@@ -258,7 +202,7 @@ package body System.Interrupts is
    Registered_Handler_Tail : R_Link := null;
 
    Access_Hold : Server_Task_Access;
-   --  variable used to allocate Server_Task using "new".
+   --  variable used to allocate Server_Task using "new"
 
    -----------------------
    -- Local Subprograms --
@@ -274,6 +218,7 @@ package body System.Interrupts is
 
    procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is
       New_Node_Ptr : R_Link;
+
    begin
       --  This routine registers the Handler as usable for Dynamic
       --  Interrupt Handler. Routines attaching and detaching Handler
@@ -310,7 +255,7 @@ package body System.Interrupts is
          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;
@@ -334,7 +279,6 @@ package body System.Interrupts is
       end loop;
 
       return False;
-
    end Is_Registered;
 
    -----------------
@@ -353,8 +297,8 @@ package body System.Interrupts is
    function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean 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";
       end if;
 
       return User_Entry (Interrupt).T /= Null_Task;
@@ -367,8 +311,8 @@ package body System.Interrupts is
    function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean 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";
       end if;
 
       return User_Handler (Interrupt).H /= null;
@@ -381,8 +325,8 @@ package body System.Interrupts is
    function Is_Blocked (Interrupt : Interrupt_ID) return Boolean 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";
       end if;
 
       return Blocked (Interrupt);
@@ -395,8 +339,8 @@ package body System.Interrupts is
    function Is_Ignored (Interrupt : Interrupt_ID) return Boolean 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";
       end if;
 
       return Ignored (Interrupt);
@@ -406,17 +350,18 @@ package body System.Interrupts is
    -- Current_Handler --
    ---------------------
 
-   function Current_Handler (Interrupt : Interrupt_ID)
-     return Parameterless_Handler is
+   function Current_Handler
+     (Interrupt : Interrupt_ID) return Parameterless_Handler
+   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";
       end if;
 
-      --  ??? Since Parameterless_Handler is not Atomic, the
-      --  current implementation is wrong. We need a new service in
-      --  Interrupt_Manager to ensure atomicity.
+      --  ??? Since Parameterless_Handler is not Atomic, the current
+      --  implementation is wrong. We need a new service in Interrupt_Manager
+      --  to ensure atomicity.
 
       return User_Handler (Interrupt).H;
    end Current_Handler;
@@ -439,8 +384,8 @@ package body System.Interrupts is
       Static      : Boolean := False) 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";
       end if;
 
       Interrupt_Manager.Attach_Handler (New_Handler, Interrupt, Static);
@@ -451,23 +396,24 @@ package body System.Interrupts is
    -- Exchange_Handler --
    ----------------------
 
-   --  Calling this procedure with New_Handler = null and Static = True
-   --  means we want to detach the current handler regardless of the
-   --  previous handler's binding status (ie. do not care if it is a
-   --  dynamic or static handler).
+   --  Calling this procedure with New_Handler = null and Static = True means
+   --  we want to detach the current handler regardless of the previous
+   --  handler's binding status (ie. do not care if it is dynamic or static
+   --  handler).
 
-   --  This option is needed so that during the finalization of a PO, we
-   --  can detach handlers attached through pragma Attach_Handler.
+   --  This option is needed so that during the finalization of a PO, we can
+   --  detach handlers attached through pragma Attach_Handler.
 
    procedure Exchange_Handler
      (Old_Handler : out Parameterless_Handler;
       New_Handler : Parameterless_Handler;
       Interrupt   : Interrupt_ID;
-      Static      : Boolean := False) is
+      Static      : Boolean := False)
+   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";
       end if;
 
       Interrupt_Manager.Exchange_Handler
@@ -492,8 +438,8 @@ package body System.Interrupts is
    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";
       end if;
 
       Interrupt_Manager.Detach_Handler (Interrupt, Static);
@@ -506,8 +452,8 @@ package body System.Interrupts is
    function Reference (Interrupt : Interrupt_ID) return System.Address 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";
       end if;
 
       return Storage_Elements.To_Address
@@ -523,7 +469,7 @@ package body System.Interrupts is
    --  already bound.
 
    procedure Bind_Interrupt_To_Entry
-     (T       : Task_ID;
+     (T       : Task_Id;
       E       : Task_Entry_Index;
       Int_Ref : System.Address)
    is
@@ -532,8 +478,8 @@ package body System.Interrupts 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";
       end if;
 
       Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt);
@@ -544,7 +490,7 @@ package body System.Interrupts is
    -- 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;
@@ -556,8 +502,8 @@ package body System.Interrupts is
    procedure Block_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";
       end if;
 
       Interrupt_Manager.Block_Interrupt (Interrupt);
@@ -570,8 +516,8 @@ package body System.Interrupts is
    procedure Unblock_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";
       end if;
 
       Interrupt_Manager.Unblock_Interrupt (Interrupt);
@@ -582,11 +528,11 @@ package body System.Interrupts is
    ------------------
 
    function Unblocked_By
-     (Interrupt : Interrupt_ID) return System.Tasking.Task_ID is
+     (Interrupt : Interrupt_ID) return System.Tasking.Task_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";
       end if;
 
       return Last_Unblocker (Interrupt);
@@ -599,8 +545,8 @@ package body System.Interrupts is
    procedure Ignore_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";
       end if;
 
       Interrupt_Manager.Ignore_Interrupt (Interrupt);
@@ -613,8 +559,8 @@ package body System.Interrupts is
    procedure Unignore_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";
       end if;
 
       Interrupt_Manager.Unignore_Interrupt (Interrupt);
@@ -626,9 +572,9 @@ package body System.Interrupts is
 
    task body Interrupt_Manager is
 
-      ---------------------
-      --  Local Routines --
-      ---------------------
+      --------------------
+      -- Local Routines --
+      --------------------
 
       procedure Unprotected_Exchange_Handler
         (Old_Handler : out Parameterless_Handler;
@@ -654,21 +600,21 @@ package body System.Interrupts is
       is
       begin
          if User_Entry (Interrupt).T /= Null_Task then
+
             --  In case we have an Interrupt Entry already installed.
             --  raise a 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
-         --  pass the following check. That is the case when we want to
-         --  Detach a handler regardless of the Static status
-         --  of the current_Handler.
-         --  We don't check anything if Restoration is True, since we
-         --  may be detaching a static handler to restore a dynamic one.
+         --  Note: A null handler with Static=True will pass the following
+         --  check. That is the case when we want to Detach a handler
+         --  regardless of the Static status of the current_Handler. We don't
+         --  check anything if Restoration is True, since we may be detaching
+         --  a static handler to restore a dynamic one.
 
          if not Restoration and then not Static
+
             --  Tries to overwrite a static Interrupt Handler with a
             --  dynamic Handler
 
@@ -679,13 +625,12 @@ package body System.Interrupts is
 
                         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;
 
-         --  The interrupt should no longer be ingnored if
-         --  it was ever ignored.
+         --  The interrupt should no longer be ingnored if it was ever ignored
 
          Ignored (Interrupt) := False;
 
@@ -699,7 +644,7 @@ package body System.Interrupts is
 
          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;
 
@@ -708,7 +653,7 @@ package body System.Interrupts is
          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 Server_ID (Interrupt) = Null_Task then
             Access_Hold := new Server_Task (Interrupt);
@@ -729,11 +674,12 @@ package body System.Interrupts is
       is
       begin
          if User_Entry (Interrupt).T /= Null_Task then
+
             --  In case we have an Interrupt Entry installed.
             --  raise a 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. That is the
@@ -744,8 +690,8 @@ package body System.Interrupts is
             --  Tries to detach a static Interrupt Handler.
             --  raise a program error.
 
-            Raise_Exception (Program_Error'Identity,
-              "Trying to detach a static Interrupt Handler");
+            raise Program_Error with
+              "Trying to detach a static Interrupt Handler";
          end if;
 
          --  The interrupt should no longer be ignored if
@@ -790,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
@@ -846,7 +792,7 @@ package body System.Interrupts is
             end Detach_Handler;
 
             or accept Bind_Interrupt_To_Entry
-              (T       : Task_ID;
+              (T       : Task_Id;
                E       : Task_Entry_Index;
                Interrupt : Interrupt_ID)
             do
@@ -856,8 +802,8 @@ package body System.Interrupts is
                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;
 
                --  The interrupt should no longer be ingnored if
@@ -875,7 +821,7 @@ package body System.Interrupts is
                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 then
 
@@ -888,7 +834,7 @@ package body System.Interrupts is
                end if;
             end Bind_Interrupt_To_Entry;
 
-            or accept Detach_Interrupt_Entries (T : Task_ID)
+            or accept Detach_Interrupt_Entries (T : Task_Id)
             do
                for J in Interrupt_ID'Range loop
                   if not Is_Reserved (J) then
@@ -905,7 +851,7 @@ package body System.Interrupts is
                   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;
@@ -951,9 +897,9 @@ package body System.Interrupts is
    -----------------
 
    task body 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;
       Intwait_Mask    : aliased IMNG.Interrupt_Mask;
 
@@ -963,7 +909,7 @@ package body System.Interrupts is
 
       System.Tasking.Utilities.Make_Independent;
 
-      --  Install default action in system level.
+      --  Install default action in system level
 
       IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
 
@@ -973,7 +919,7 @@ package body System.Interrupts is
       IMOP.Add_To_Interrupt_Mask
         (Intwait_Mask'Access, IMNG.Interrupt_ID (Interrupt));
 
-      --  Remember the Interrupt_ID for Abort_Task.
+      --  Remember the Interrupt_ID for Abort_Task
 
       PIO.Set_Interrupt_ID (IMNG.Interrupt_ID (Interrupt), Self_ID);
 
@@ -1021,7 +967,7 @@ package body System.Interrupts is
                if User_Handler (Interrupt).H /= null then
                   Tmp_Handler := User_Handler (Interrupt).H;
 
-                  --  RTS calls should not be made with self being locked.
+                  --  RTS calls should not be made with self being locked
 
                   POP.Unlock (Self_ID);
 
@@ -1041,7 +987,7 @@ package body System.Interrupts is
                   Tmp_ID := User_Entry (Interrupt).T;
                   Tmp_Entry_Index := User_Entry (Interrupt).E;
 
-                  --  RTS calls should not be made with self being locked.
+                  --  RTS calls should not be made with self being locked
 
                   POP.Unlock (Self_ID);
 
@@ -1079,8 +1025,7 @@ package body System.Interrupts is
    -------------------------------------
 
    function Has_Interrupt_Or_Attach_Handler
-     (Object : access Dynamic_Interrupt_Protection)
-      return   Boolean
+     (Object : access Dynamic_Interrupt_Protection) return Boolean
    is
       pragma Warnings (Off, Object);
 
@@ -1088,14 +1033,15 @@ package body System.Interrupts is
       return True;
    end Has_Interrupt_Or_Attach_Handler;
 
-   ----------------
-   --  Finalize  --
-   ----------------
+   --------------
+   -- Finalize --
+   --------------
 
    procedure Finalize (Object : in out Static_Interrupt_Protection) is
    begin
       --  ??? loop to be executed only when we're not doing library level
       --  finalization, since in this case all interrupt tasks are gone.
+
       if not Interrupt_Manager'Terminated then
          for N in reverse Object.Previous_Handlers'Range loop
             Interrupt_Manager.Attach_Handler
@@ -1115,8 +1061,7 @@ package body System.Interrupts is
    -------------------------------------
 
    function Has_Interrupt_Or_Attach_Handler
-     (Object : access Static_Interrupt_Protection)
-      return   Boolean
+     (Object : access Static_Interrupt_Protection) return Boolean
    is
       pragma Warnings (Off, Object);
    begin
@@ -1151,26 +1096,35 @@ 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
 
-   --  Get Interrupt_Manager's ID so that Abort_Interrupt can be sent.
+begin
+   --  Get Interrupt_Manager's ID so that Abort_Interrupt can be sent
 
    Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
 
-   --  During the elaboration of this package body we want RTS to
-   --  inherit the interrupt mask from the Environment Task.
+   --  During the elaboration of this package body we want RTS to inherit the
+   --  interrupt mask from the Environment Task.
 
-   --  The Environment Task should have gotten its mask from
-   --  the enclosing process during the RTS start up. (See
-   --  in s-inmaop.adb). Pass the Interrupt_Mask of the Environment
-   --  task to the Interrupt_Manager.
+   --  The Environment Task should have gotten its mask from the enclosing
+   --  process during the RTS start up. (See in s-inmaop.adb). Pass the
+   --  Interrupt_Mask of the Environment task to the Interrupt_Manager.
 
-   --  Note : At this point we know that all tasks (including
-   --  RTS internal servers) are masked for non-reserved signals
-   --  (see s-taprop.adb). Only the Interrupt_Manager will have
-   --  masks set up differently inheriting the original Environment
-   --  Task's mask.
+   --  Note : At this point we know that all tasks (including RTS internal
+   --  servers) are masked for non-reserved signals (see s-taprop.adb). Only
+   --  the Interrupt_Manager will have masks set up differently inheriting the
+   --  original Environment Task's mask.
 
    Interrupt_Manager.Initialize (IMOP.Environment_Mask);
 end System.Interrupts;