gcc/ada/s-interr.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
   4 --                                                                          --
   5 --                     S Y S T E M . I N T E R R U P T S                    --
   6 --                                                                          --
   7 --                                  B o d y                                 --
   8 --                                                                          --
   9 --         Copyright (C) 1992-2007, Free Software Foundation, Inc.          --
  10 --                                                                          --
  11 -- GNARL is free software; you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNARL; see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNARL was developed by the GNARL team at Florida State University.       --
  30 -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 --  Invariants:
  35
  36 --  All user-handleable interrupts are masked at all times in all
  37 --  tasks/threads except possibly for the Interrupt_Manager task.
  38
  39 --  When a user task wants to have the effect of masking/unmasking an
  40 --  interrupt, it must call Block_Interrupt/Unblock_Interrupt, which
  41 --  will have the effect of unmasking/masking the interrupt in the
  42 --  Interrupt_Manager task.
  43
  44 --  Note : Direct calls to sigaction, sigprocmask, pthread_sigsetmask or any
  45 --  other low-level interface that changes the interrupt action or
  46 --  interrupt mask needs a careful thought.
  47 --  One may acheive the effect of system calls first masking RTS blocked
  48 --  (by calling Block_Interrupt) for the interrupt under consideration.
  49 --  This will make all the tasks in RTS blocked for the Interrupt.
  50
  51 --  Once we associate a Server_Task with an interrupt, the task never
  52 --  goes away, and we never remove the association.
  53
  54 --  There is no more than one interrupt per Server_Task and no more than
  55 --  one Server_Task per interrupt.
  56
  57 with Ada.Task_Identification;
  58 --  used for Task_Id type
  59
  60 with Ada.Exceptions;
  61 --  used for Raise_Exception
  62
  63 with System.Task_Primitives;
  64 --  used for RTS_Lock
  65 --           Self
  66
  67 with System.Interrupt_Management;
  68 --  used for Reserve
  69 --           Interrupt_ID
  70 --           Interrupt_Mask
  71 --           Abort_Task_Interrupt
  72
  73 with System.Interrupt_Management.Operations;
  74 --  used for Thread_Block_Interrupt
  75 --           Thread_Unblock_Interrupt
  76 --           Install_Default_Action
  77 --           Install_Ignore_Action
  78 --           Copy_Interrupt_Mask
  79 --           Set_Interrupt_Mask
  80 --           Empty_Interrupt_Mask
  81 --           Fill_Interrupt_Mask
  82 --           Add_To_Interrupt_Mask
  83 --           Delete_From_Interrupt_Mask
  84 --           Interrupt_Wait
  85 --           Interrupt_Self_Process
  86 --           Get_Interrupt_Mask
  87 --           Set_Interrupt_Mask
  88 --           IS_Member
  89 --           Environment_Mask
  90 --           All_Tasks_Mask
  91 pragma Elaborate_All (System.Interrupt_Management.Operations);
  92
  93 with System.Task_Primitives.Operations;
  94 --  used for Write_Lock
  95 --           Unlock
  96 --           Abort
  97 --           Wakeup_Task
  98 --           Sleep
  99 --           Initialize_Lock
 100
 101 with System.Task_Primitives.Interrupt_Operations;
 102 --  used for Set_Interrupt_ID
 103
 104 with System.Storage_Elements;
 105 --  used for To_Address
 106 --           To_Integer
 107 --           Integer_Address
 108
 109 with System.Tasking.Utilities;
 110 --  used for Make_Independent
 111
 112 with System.Tasking.Rendezvous;
 113 --  used for Call_Simple
 114 pragma Elaborate_All (System.Tasking.Rendezvous);
 115
 116 with System.Tasking.Initialization;
 117 --  used for Defer_Abort
 118 --           Undefer_Abort
 119
 120 with System.Parameters;
 121 --  used for Single_Lock
 122
 123 with Ada.Unchecked_Conversion;
 124
 125 package body System.Interrupts is
 126
 127    use Parameters;
 128    use Tasking;
 129    use Ada.Exceptions;
 130
 131    package POP renames System.Task_Primitives.Operations;
 132    package PIO renames System.Task_Primitives.Interrupt_Operations;
 133    package IMNG renames System.Interrupt_Management;
 134    package IMOP renames System.Interrupt_Management.Operations;
 135
 136    function To_System is new Ada.Unchecked_Conversion
 137      (Ada.Task_Identification.Task_Id, Task_Id);
 138
 139    -----------------
 140    -- Local Tasks --
 141    -----------------
 142
 143    --  WARNING: System.Tasking.Stages performs calls to this task
 144    --  with low-level constructs. Do not change this spec without synchro-
 145    --  nizing it.
 146
 147    task Interrupt_Manager is
 148       entry Detach_Interrupt_Entries (T : Task_Id);
 149
 150       entry Initialize (Mask : IMNG.Interrupt_Mask);
 151
 152       entry Attach_Handler
 153         (New_Handler : Parameterless_Handler;
 154          Interrupt   : Interrupt_ID;
 155          Static      : Boolean;
 156          Restoration : Boolean := False);
 157
 158       entry Exchange_Handler
 159         (Old_Handler : out Parameterless_Handler;
 160          New_Handler : Parameterless_Handler;
 161          Interrupt   : Interrupt_ID;
 162          Static      : Boolean);
 163
 164       entry Detach_Handler
 165         (Interrupt   : Interrupt_ID;
 166          Static      : Boolean);
 167
 168       entry Bind_Interrupt_To_Entry
 169         (T         : Task_Id;
 170          E         : Task_Entry_Index;
 171          Interrupt : Interrupt_ID);
 172
 173       entry Block_Interrupt (Interrupt : Interrupt_ID);
 174
 175       entry Unblock_Interrupt (Interrupt : Interrupt_ID);
 176
 177       entry Ignore_Interrupt (Interrupt : Interrupt_ID);
 178
 179       entry Unignore_Interrupt (Interrupt : Interrupt_ID);
 180
 181       pragma Interrupt_Priority (System.Interrupt_Priority'Last);
 182    end Interrupt_Manager;
 183
 184    task type Server_Task (Interrupt : Interrupt_ID) is
 185       pragma Priority (System.Interrupt_Priority'Last);
 186       --  Note: the above pragma Priority is strictly speaking improper
 187       --  since it is outside the range of allowed priorities, but the
 188       --  compiler treats system units specially and does not apply
 189       --  this range checking rule to system units.
 190
 191    end Server_Task;
 192
 193    type Server_Task_Access is access Server_Task;
 194
 195    -------------------------------
 196    -- Local Types and Variables --
 197    -------------------------------
 198
 199    type Entry_Assoc is record
 200       T : Task_Id;
 201       E : Task_Entry_Index;
 202    end record;
 203
 204    type Handler_Assoc is record
 205       H      : Parameterless_Handler;
 206       Static : Boolean;   --  Indicates static binding;
 207    end record;
 208
 209    User_Handler : array (Interrupt_ID'Range) of Handler_Assoc :=
 210                     (others => (null, Static => False));
 211    pragma Volatile_Components (User_Handler);
 212    --  Holds the protected procedure handler (if any) and its Static
 213    --  information  for each interrupt. A handler is a Static one if
 214    --  it is specified through the pragma Attach_Handler.
 215    --  Attach_Handler. Otherwise, not static)
 216
 217    User_Entry : array (Interrupt_ID'Range) of Entry_Assoc :=
 218                   (others => (T => Null_Task, E => Null_Task_Entry));
 219    pragma Volatile_Components (User_Entry);
 220    --  Holds the task and entry index (if any) for each interrupt
 221
 222    Blocked : array (Interrupt_ID'Range) of Boolean := (others => False);
 223    pragma Atomic_Components (Blocked);
 224    --  True iff the corresponding interrupt is blocked in the process level
 225
 226    Ignored : array (Interrupt_ID'Range) of Boolean := (others => False);
 227    pragma Atomic_Components (Ignored);
 228    --  True iff the corresponding interrupt is blocked in the process level
 229
 230    Last_Unblocker :
 231      array (Interrupt_ID'Range) of Task_Id := (others => Null_Task);
 232    pragma Atomic_Components (Last_Unblocker);
 233    --  Holds the ID of the last Task which Unblocked this Interrupt.
 234    --  It contains Null_Task if no tasks have ever requested the
 235    --  Unblocking operation or the Interrupt is currently Blocked.
 236
 237    Server_ID : array (Interrupt_ID'Range) of Task_Id :=
 238                  (others => Null_Task);
 239    pragma Atomic_Components (Server_ID);
 240    --  Holds the Task_Id of the Server_Task for each interrupt.
 241    --  Task_Id is needed to accomplish locking per Interrupt base. Also
 242    --  is needed to decide whether to create a new Server_Task.
 243
 244    --  Type and Head, Tail of the list containing Registered Interrupt
 245    --  Handlers. These definitions are used to register the handlers
 246    --  specified by the pragma Interrupt_Handler.
 247
 248    type Registered_Handler;
 249    type R_Link is access all Registered_Handler;
 250
 251    type Registered_Handler is record
 252       H    : System.Address := System.Null_Address;
 253       Next : R_Link := null;
 254    end record;
 255
 256    Registered_Handler_Head : R_Link := null;
 257    Registered_Handler_Tail : R_Link := null;
 258
 259    Access_Hold : Server_Task_Access;
 260    --  variable used to allocate Server_Task using "new".
 261
 262    -----------------------
 263    -- Local Subprograms --
 264    -----------------------
 265
 266    function Is_Registered (Handler : Parameterless_Handler) return Boolean;
 267    --  See if the Handler has been "pragma"ed using Interrupt_Handler.
 268    --  Always consider a null handler as registered.
 269
 270    --------------------
 271    -- Attach_Handler --
 272    --------------------
 273
 274    --  Calling this procedure with New_Handler = null and Static = True
 275    --  means we want to detach the current handler regardless of the
 276    --  previous handler's binding status (ie. do not care if it is a
 277    --  dynamic or static handler).
 278
 279    --  This option is needed so that during the finalization of a PO, we
 280    --  can detach handlers attached through pragma Attach_Handler.
 281
 282    procedure Attach_Handler
 283      (New_Handler : Parameterless_Handler;
 284       Interrupt   : Interrupt_ID;
 285       Static      : Boolean := False)
 286    is
 287    begin
 288       if Is_Reserved (Interrupt) then
 289          Raise_Exception (Program_Error'Identity, "Interrupt" &
 290            Interrupt_ID'Image (Interrupt) & " is reserved");
 291       end if;
 292
 293       Interrupt_Manager.Attach_Handler (New_Handler, Interrupt, Static);
 294
 295    end Attach_Handler;
 296
 297    -----------------------------
 298    -- Bind_Interrupt_To_Entry --
 299    -----------------------------
 300
 301    --  This procedure raises a Program_Error if it tries to bind an
 302    --  interrupt to which an Entry or a Procedure is already bound.
 303
 304    procedure Bind_Interrupt_To_Entry
 305      (T       : Task_Id;
 306       E       : Task_Entry_Index;
 307       Int_Ref : System.Address)
 308    is
 309       Interrupt   : constant Interrupt_ID :=
 310                       Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
 311
 312    begin
 313       if Is_Reserved (Interrupt) then
 314          Raise_Exception (Program_Error'Identity, "Interrupt" &
 315            Interrupt_ID'Image (Interrupt) & " is reserved");
 316       end if;
 317
 318       Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt);
 319    end Bind_Interrupt_To_Entry;
 320
 321    ---------------------
 322    -- Block_Interrupt --
 323    ---------------------
 324
 325    procedure Block_Interrupt (Interrupt : Interrupt_ID) is
 326    begin
 327       if Is_Reserved (Interrupt) then
 328          Raise_Exception (Program_Error'Identity, "Interrupt" &
 329            Interrupt_ID'Image (Interrupt) & " is reserved");
 330       end if;
 331
 332       Interrupt_Manager.Block_Interrupt (Interrupt);
 333    end Block_Interrupt;
 334
 335    ---------------------
 336    -- Current_Handler --
 337    ---------------------
 338
 339    function Current_Handler
 340      (Interrupt : Interrupt_ID) return Parameterless_Handler
 341    is
 342    begin
 343       if Is_Reserved (Interrupt) then
 344          Raise_Exception (Program_Error'Identity, "Interrupt" &
 345            Interrupt_ID'Image (Interrupt) & " is reserved");
 346       end if;
 347
 348       --  ??? Since Parameterless_Handler is not Atomic, the current
 349       --  implementation is wrong. We need a new service in Interrupt_Manager
 350       --  to ensure atomicity.
 351
 352       return User_Handler (Interrupt).H;
 353    end Current_Handler;
 354
 355    --------------------
 356    -- Detach_Handler --
 357    --------------------
 358
 359    --  Calling this procedure with Static = True means we want to Detach the
 360    --  current handler regardless of the previous handler's binding status
 361    --  (i.e. do not care if it is a dynamic or static handler).
 362
 363    --  This option is needed so that during the finalization of a PO, we can
 364    --  detach handlers attached through pragma Attach_Handler.
 365
 366    procedure Detach_Handler
 367      (Interrupt : Interrupt_ID;
 368       Static    : Boolean := False)
 369    is
 370    begin
 371       if Is_Reserved (Interrupt) then
 372          Raise_Exception (Program_Error'Identity, "Interrupt" &
 373            Interrupt_ID'Image (Interrupt) & " is reserved");
 374       end if;
 375
 376       Interrupt_Manager.Detach_Handler (Interrupt, Static);
 377    end Detach_Handler;
 378
 379    ------------------------------
 380    -- Detach_Interrupt_Entries --
 381    ------------------------------
 382
 383    procedure Detach_Interrupt_Entries (T : Task_Id) is
 384    begin
 385       Interrupt_Manager.Detach_Interrupt_Entries (T);
 386    end Detach_Interrupt_Entries;
 387
 388    ----------------------
 389    -- Exchange_Handler --
 390    ----------------------
 391
 392    --  Calling this procedure with New_Handler = null and Static = True
 393    --  means we want to detach the current handler regardless of the
 394    --  previous handler's binding status (ie. do not care if it is a
 395    --  dynamic or static handler).
 396
 397    --  This option is needed so that during the finalization of a PO,
 398    --  we can detach handlers attached through pragma Attach_Handler.
 399
 400    procedure Exchange_Handler
 401      (Old_Handler : out Parameterless_Handler;
 402       New_Handler : Parameterless_Handler;
 403       Interrupt   : Interrupt_ID;
 404       Static      : Boolean := False)
 405    is
 406    begin
 407       if Is_Reserved (Interrupt) then
 408          Raise_Exception (Program_Error'Identity, "Interrupt" &
 409            Interrupt_ID'Image (Interrupt) & " is reserved");
 410       end if;
 411
 412       Interrupt_Manager.Exchange_Handler
 413         (Old_Handler, New_Handler, Interrupt, Static);
 414    end Exchange_Handler;
 415
 416    --------------
 417    -- Finalize --
 418    --------------
 419
 420    procedure Finalize (Object : in out Static_Interrupt_Protection) is
 421    begin
 422       --  ??? loop to be executed only when we're not doing library level
 423       --  finalization, since in this case all interrupt tasks are gone.
 424
 425       if not Interrupt_Manager'Terminated then
 426          for N in reverse Object.Previous_Handlers'Range loop
 427             Interrupt_Manager.Attach_Handler
 428               (New_Handler => Object.Previous_Handlers (N).Handler,
 429                Interrupt   => Object.Previous_Handlers (N).Interrupt,
 430                Static      => Object.Previous_Handlers (N).Static,
 431                Restoration => True);
 432          end loop;
 433       end if;
 434
 435       Tasking.Protected_Objects.Entries.Finalize
 436         (Tasking.Protected_Objects.Entries.Protection_Entries (Object));
 437    end Finalize;
 438
 439    -------------------------------------
 440    -- Has_Interrupt_Or_Attach_Handler --
 441    -------------------------------------
 442
 443    --  Need comments as to why these always return True ???
 444
 445    function Has_Interrupt_Or_Attach_Handler
 446      (Object : access Dynamic_Interrupt_Protection) return Boolean
 447    is
 448       pragma Unreferenced (Object);
 449    begin
 450       return True;
 451    end Has_Interrupt_Or_Attach_Handler;
 452
 453    function Has_Interrupt_Or_Attach_Handler
 454      (Object : access Static_Interrupt_Protection) return Boolean
 455    is
 456       pragma Unreferenced (Object);
 457    begin
 458       return True;
 459    end Has_Interrupt_Or_Attach_Handler;
 460
 461    ----------------------
 462    -- Ignore_Interrupt --
 463    ----------------------
 464
 465    procedure Ignore_Interrupt (Interrupt : Interrupt_ID) is
 466    begin
 467       if Is_Reserved (Interrupt) then
 468          Raise_Exception (Program_Error'Identity, "Interrupt" &
 469            Interrupt_ID'Image (Interrupt) & " is reserved");
 470       end if;
 471
 472       Interrupt_Manager.Ignore_Interrupt (Interrupt);
 473    end Ignore_Interrupt;
 474
 475    ----------------------
 476    -- Install_Handlers --
 477    ----------------------
 478
 479    procedure Install_Handlers
 480      (Object       : access Static_Interrupt_Protection;
 481       New_Handlers : New_Handler_Array)
 482    is
 483    begin
 484       for N in New_Handlers'Range loop
 485
 486          --  We need a lock around this ???
 487
 488          Object.Previous_Handlers (N).Interrupt := New_Handlers (N).Interrupt;
 489          Object.Previous_Handlers (N).Static    := User_Handler
 490            (New_Handlers (N).Interrupt).Static;
 491
 492          --  We call Exchange_Handler and not directly Interrupt_Manager.
 493          --  Exchange_Handler so we get the Is_Reserved check.
 494
 495          Exchange_Handler
 496            (Old_Handler => Object.Previous_Handlers (N).Handler,
 497             New_Handler => New_Handlers (N).Handler,
 498             Interrupt   => New_Handlers (N).Interrupt,
 499             Static      => True);
 500       end loop;
 501    end Install_Handlers;
 502
 503    ----------------
 504    -- Is_Blocked --
 505    ----------------
 506
 507    function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is
 508    begin
 509       if Is_Reserved (Interrupt) then
 510          Raise_Exception (Program_Error'Identity, "Interrupt" &
 511            Interrupt_ID'Image (Interrupt) & " is reserved");
 512       end if;
 513
 514       return Blocked (Interrupt);
 515    end Is_Blocked;
 516
 517    -----------------------
 518    -- Is_Entry_Attached --
 519    -----------------------
 520
 521    function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is
 522    begin
 523       if Is_Reserved (Interrupt) then
 524          Raise_Exception (Program_Error'Identity, "Interrupt" &
 525            Interrupt_ID'Image (Interrupt) & " is reserved");
 526       end if;
 527
 528       return User_Entry (Interrupt).T /= Null_Task;
 529    end Is_Entry_Attached;
 530
 531    -------------------------
 532    -- Is_Handler_Attached --
 533    -------------------------
 534
 535    function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is
 536    begin
 537       if Is_Reserved (Interrupt) then
 538          Raise_Exception (Program_Error'Identity, "Interrupt" &
 539            Interrupt_ID'Image (Interrupt) & " is reserved");
 540       end if;
 541
 542       return User_Handler (Interrupt).H /= null;
 543    end Is_Handler_Attached;
 544
 545    ----------------
 546    -- Is_Ignored --
 547    ----------------
 548
 549    function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is
 550    begin
 551       if Is_Reserved (Interrupt) then
 552          Raise_Exception (Program_Error'Identity, "Interrupt" &
 553            Interrupt_ID'Image (Interrupt) & " is reserved");
 554       end if;
 555
 556       return Ignored (Interrupt);
 557    end Is_Ignored;
 558
 559    -------------------
 560    -- Is_Registered --
 561    -------------------
 562
 563    function Is_Registered (Handler : Parameterless_Handler) return Boolean is
 564
 565       type Fat_Ptr is record
 566          Object_Addr  : System.Address;
 567          Handler_Addr : System.Address;
 568       end record;
 569
 570       function To_Fat_Ptr is new Ada.Unchecked_Conversion
 571         (Parameterless_Handler, Fat_Ptr);
 572
 573       Ptr : R_Link;
 574       Fat : Fat_Ptr;
 575
 576    begin
 577       if Handler = null then
 578          return True;
 579       end if;
 580
 581       Fat := To_Fat_Ptr (Handler);
 582
 583       Ptr := Registered_Handler_Head;
 584
 585       while Ptr /= null loop
 586          if Ptr.H = Fat.Handler_Addr then
 587             return True;
 588          end if;
 589
 590          Ptr := Ptr.Next;
 591       end loop;
 592
 593       return False;
 594    end Is_Registered;
 595
 596    -----------------
 597    -- Is_Reserved --
 598    -----------------
 599
 600    function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is
 601    begin
 602       return IMNG.Reserve (IMNG.Interrupt_ID (Interrupt));
 603    end Is_Reserved;
 604
 605    ---------------
 606    -- Reference --
 607    ---------------
 608
 609    function Reference (Interrupt : Interrupt_ID) return System.Address is
 610    begin
 611       if Is_Reserved (Interrupt) then
 612          Raise_Exception (Program_Error'Identity, "Interrupt" &
 613            Interrupt_ID'Image (Interrupt) & " is reserved");
 614       end if;
 615
 616       return Storage_Elements.To_Address
 617         (Storage_Elements.Integer_Address (Interrupt));
 618    end Reference;
 619
 620    ---------------------------------
 621    -- Register_Interrupt_Handler  --
 622    ---------------------------------
 623
 624    procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is
 625       New_Node_Ptr : R_Link;
 626
 627    begin
 628       --  This routine registers the Handler as usable for Dynamic Interrupt
 629       --  Handler. Routines attaching and detaching Handler dynamically should
 630       --  first consult if the Handler is registered. A Program Error should
 631       --  be raised if it is not registered.
 632
 633       --  The pragma Interrupt_Handler can only appear in the library level PO
 634       --  definition and instantiation. Therefore, we do not need to implement
 635       --  Unregistering operation. Neither we need to protect the queue
 636       --  structure using a Lock.
 637
 638       pragma Assert (Handler_Addr /= System.Null_Address);
 639
 640       New_Node_Ptr := new Registered_Handler;
 641       New_Node_Ptr.H := Handler_Addr;
 642
 643       if Registered_Handler_Head = null then
 644          Registered_Handler_Head := New_Node_Ptr;
 645          Registered_Handler_Tail := New_Node_Ptr;
 646
 647       else
 648          Registered_Handler_Tail.Next := New_Node_Ptr;
 649          Registered_Handler_Tail := New_Node_Ptr;
 650       end if;
 651    end Register_Interrupt_Handler;
 652
 653    -----------------------
 654    -- Unblock_Interrupt --
 655    -----------------------
 656
 657    procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is
 658    begin
 659       if Is_Reserved (Interrupt) then
 660          Raise_Exception (Program_Error'Identity, "Interrupt" &
 661            Interrupt_ID'Image (Interrupt) & " is reserved");
 662       end if;
 663
 664       Interrupt_Manager.Unblock_Interrupt (Interrupt);
 665    end Unblock_Interrupt;
 666
 667    ------------------
 668    -- Unblocked_By --
 669    ------------------
 670
 671    function Unblocked_By
 672      (Interrupt : Interrupt_ID) return System.Tasking.Task_Id
 673    is
 674    begin
 675       if Is_Reserved (Interrupt) then
 676          Raise_Exception (Program_Error'Identity, "Interrupt" &
 677            Interrupt_ID'Image (Interrupt) & " is reserved");
 678       end if;
 679
 680       return Last_Unblocker (Interrupt);
 681    end Unblocked_By;
 682
 683    ------------------------
 684    -- Unignore_Interrupt --
 685    ------------------------
 686
 687    procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is
 688    begin
 689       if Is_Reserved (Interrupt) then
 690          Raise_Exception (Program_Error'Identity, "Interrupt" &
 691            Interrupt_ID'Image (Interrupt) & " is reserved");
 692       end if;
 693
 694       Interrupt_Manager.Unignore_Interrupt (Interrupt);
 695    end Unignore_Interrupt;
 696
 697    -----------------------
 698    -- Interrupt_Manager --
 699    -----------------------
 700
 701    task body Interrupt_Manager is
 702
 703       ---------------------
 704       -- Local Variables --
 705       ---------------------
 706
 707       Intwait_Mask  : aliased IMNG.Interrupt_Mask;
 708       Ret_Interrupt : Interrupt_ID;
 709       Old_Mask      : aliased IMNG.Interrupt_Mask;
 710       Old_Handler   : Parameterless_Handler;
 711
 712       --------------------
 713       -- Local Routines --
 714       --------------------
 715
 716       procedure Bind_Handler (Interrupt : Interrupt_ID);
 717       --  This procedure does not do anything if the Interrupt is blocked.
 718       --  Otherwise, we have to interrupt Server_Task for status change through
 719       --  Wakeup interrupt.
 720
 721       procedure Unbind_Handler (Interrupt : Interrupt_ID);
 722       --  This procedure does not do anything if the Interrupt is blocked.
 723       --  Otherwise, we have to interrupt Server_Task for status change
 724       --  through abort interrupt.
 725
 726       procedure Unprotected_Exchange_Handler
 727         (Old_Handler : out Parameterless_Handler;
 728          New_Handler : Parameterless_Handler;
 729          Interrupt   : Interrupt_ID;
 730          Static      : Boolean;
 731          Restoration : Boolean := False);
 732
 733       procedure Unprotected_Detach_Handler
 734         (Interrupt   : Interrupt_ID;
 735          Static      : Boolean);
 736
 737       ------------------
 738       -- Bind_Handler --
 739       ------------------
 740
 741       procedure Bind_Handler (Interrupt : Interrupt_ID) is
 742       begin
 743          if not Blocked (Interrupt) then
 744
 745             --  Mask this task for the given Interrupt so that all tasks
 746             --  are masked for the Interrupt and the actuall delivery of the
 747             --  Interrupt will be caught using "sigwait" by the
 748             --  corresponding Server_Task.
 749
 750             IMOP.Thread_Block_Interrupt (IMNG.Interrupt_ID (Interrupt));
 751
 752             --  We have installed a Handler or an Entry before we called
 753             --  this procedure. If the Handler Task is waiting to be awakened,
 754             --  do it here. Otherwise, the interrupt will be discarded.
 755
 756             POP.Wakeup (Server_ID (Interrupt), Interrupt_Server_Idle_Sleep);
 757          end if;
 758       end Bind_Handler;
 759
 760       --------------------
 761       -- Unbind_Handler --
 762       --------------------
 763
 764       procedure Unbind_Handler (Interrupt : Interrupt_ID) is
 765          Server : System.Tasking.Task_Id;
 766       begin
 767          if not Blocked (Interrupt) then
 768             --  Currently, there is a Handler or an Entry attached and
 769             --  corresponding Server_Task is waiting on "sigwait."
 770             --  We have to wake up the Server_Task and make it
 771             --  wait on condition variable by sending an
 772             --  Abort_Task_Interrupt
 773
 774             Server := Server_ID (Interrupt);
 775
 776             case Server.Common.State is
 777                when Interrupt_Server_Idle_Sleep |
 778                     Interrupt_Server_Blocked_Interrupt_Sleep
 779                =>
 780                   POP.Wakeup (Server, Server.Common.State);
 781
 782                when Interrupt_Server_Blocked_On_Event_Flag =>
 783                   POP.Abort_Task (Server);
 784
 785                   --  Make sure corresponding Server_Task is out of its
 786                   --  own sigwait state.
 787
 788                   Ret_Interrupt :=
 789                     Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access));
 790                   pragma Assert
 791                     (Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt));
 792
 793                when Runnable =>
 794                   null;
 795
 796                when others =>
 797                   pragma Assert (False);
 798                   null;
 799             end case;
 800
 801             IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
 802
 803             --  Unmake the Interrupt for this task in order to allow default
 804             --  action again.
 805
 806             IMOP.Thread_Unblock_Interrupt (IMNG.Interrupt_ID (Interrupt));
 807
 808          else
 809             IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
 810          end if;
 811       end Unbind_Handler;
 812
 813       --------------------------------
 814       -- Unprotected_Detach_Handler --
 815       --------------------------------
 816
 817       procedure Unprotected_Detach_Handler
 818         (Interrupt   : Interrupt_ID;
 819          Static      : Boolean)
 820       is
 821          Old_Handler : Parameterless_Handler;
 822
 823       begin
 824          if User_Entry (Interrupt).T /= Null_Task then
 825
 826             --  In case we have an Interrupt Entry installed.
 827             --  raise a program error. (propagate it to the caller).
 828
 829             Raise_Exception (Program_Error'Identity,
 830               "An interrupt entry is already installed");
 831          end if;
 832
 833          --  Note : Static = True will pass the following check. That is the
 834          --  case when we want to detach a handler regardless of the static
 835          --  status of the current_Handler.
 836
 837          if not Static and then User_Handler (Interrupt).Static then
 838
 839             --  Tries to detach a static Interrupt Handler.
 840             --  raise a program error.
 841
 842             Raise_Exception (Program_Error'Identity,
 843               "Trying to detach a static Interrupt Handler");
 844          end if;
 845
 846          --  The interrupt should no longer be ignored if
 847          --  it was ever ignored.
 848
 849          Ignored (Interrupt) := False;
 850
 851          Old_Handler := User_Handler (Interrupt).H;
 852
 853          --  The new handler
 854
 855          User_Handler (Interrupt).H := null;
 856          User_Handler (Interrupt).Static := False;
 857
 858          if Old_Handler /= null then
 859             Unbind_Handler (Interrupt);
 860          end if;
 861       end Unprotected_Detach_Handler;
 862
 863       ----------------------------------
 864       -- Unprotected_Exchange_Handler --
 865       ----------------------------------
 866
 867       procedure Unprotected_Exchange_Handler
 868         (Old_Handler : out Parameterless_Handler;
 869          New_Handler : Parameterless_Handler;
 870          Interrupt   : Interrupt_ID;
 871          Static      : Boolean;
 872          Restoration : Boolean := False)
 873       is
 874       begin
 875          if User_Entry (Interrupt).T /= Null_Task then
 876
 877             --  In case we have an Interrupt Entry already installed.
 878             --  raise a program error. (propagate it to the caller).
 879
 880             Raise_Exception (Program_Error'Identity,
 881               "An interrupt is already installed");
 882          end if;
 883
 884          --  Note : A null handler with Static = True will pass the
 885          --  following check. That is the case when we want to Detach a
 886          --  handler regardless of the Static status of the current_Handler.
 887
 888          --  We don't check anything if Restoration is True, since we
 889          --  may be detaching a static handler to restore a dynamic one.
 890
 891          if not Restoration and then not Static
 892
 893             --  Tries to overwrite a static Interrupt Handler with a
 894             --  dynamic Handler
 895
 896            and then (User_Handler (Interrupt).Static
 897
 898                         --  The new handler is not specified as an
 899                         --  Interrupt Handler by a pragma.
 900
 901                         or else not Is_Registered (New_Handler))
 902          then
 903             Raise_Exception (Program_Error'Identity,
 904               "Trying to overwrite a static Interrupt Handler with a " &
 905               "dynamic Handler");
 906          end if;
 907
 908          --  The interrupt should no longer be ingnored if
 909          --  it was ever ignored.
 910
 911          Ignored (Interrupt) := False;
 912
 913          --  Save the old handler
 914
 915          Old_Handler := User_Handler (Interrupt).H;
 916
 917          --  The new handler
 918
 919          User_Handler (Interrupt).H := New_Handler;
 920
 921          if New_Handler = null then
 922
 923             --  The null handler means we are detaching the handler.
 924
 925             User_Handler (Interrupt).Static := False;
 926
 927          else
 928             User_Handler (Interrupt).Static := Static;
 929          end if;
 930
 931          --  Invoke a corresponding Server_Task if not yet created.
 932          --  Place Task_Id info in Server_ID array.
 933
 934          if Server_ID (Interrupt) = Null_Task then
 935
 936             --  When a new Server_Task is created, it should have its
 937             --  signal mask set to the All_Tasks_Mask.
 938
 939             IMOP.Set_Interrupt_Mask
 940               (IMOP.All_Tasks_Mask'Access, Old_Mask'Access);
 941             Access_Hold := new Server_Task (Interrupt);
 942             IMOP.Set_Interrupt_Mask (Old_Mask'Access);
 943
 944             Server_ID (Interrupt) := To_System (Access_Hold.all'Identity);
 945          end if;
 946
 947          if New_Handler = null then
 948             if Old_Handler /= null then
 949                Unbind_Handler (Interrupt);
 950             end if;
 951
 952             return;
 953          end if;
 954
 955          if Old_Handler = null then
 956             Bind_Handler (Interrupt);
 957          end if;
 958       end Unprotected_Exchange_Handler;
 959
 960    --  Start of processing for Interrupt_Manager
 961
 962    begin
 963       --  By making this task independent of master, when the process
 964       --  goes away, the Interrupt_Manager will terminate gracefully.
 965
 966       System.Tasking.Utilities.Make_Independent;
 967
 968       --  Environment task gets its own interrupt mask, saves it,
 969       --  and then masks all interrupts except the Keep_Unmasked set.
 970
 971       --  During rendezvous, the Interrupt_Manager receives the old
 972       --  interrupt mask of the environment task, and sets its own
 973       --  interrupt mask to that value.
 974
 975       --  The environment task will call the entry of Interrupt_Manager some
 976       --  during elaboration of the body of this package.
 977
 978       accept Initialize (Mask : IMNG.Interrupt_Mask) do
 979          declare
 980             The_Mask : aliased IMNG.Interrupt_Mask;
 981
 982          begin
 983             IMOP.Copy_Interrupt_Mask (The_Mask, Mask);
 984             IMOP.Set_Interrupt_Mask (The_Mask'Access);
 985          end;
 986       end Initialize;
 987
 988       --  Note: All tasks in RTS will have all the Reserve Interrupts
 989       --  being masked (except the Interrupt_Manager) and Keep_Unmasked
 990       --  unmasked when created.
 991
 992       --  Abort_Task_Interrupt is one of the Interrupt unmasked
 993       --  in all tasks. We mask the Interrupt in this particular task
 994       --  so that "sigwait" is possible to catch an explicitely sent
 995       --  Abort_Task_Interrupt from the Server_Tasks.
 996
 997       --  This sigwaiting is needed so that we make sure a Server_Task is
 998       --  out of its own sigwait state. This extra synchronization is
 999       --  necessary to prevent following senarios.
1000
1001       --   1) Interrupt_Manager sends an Abort_Task_Interrupt to the
1002       --      Server_Task then changes its own interrupt mask (OS level).
1003       --      If an interrupt (corresponding to the Server_Task) arrives
1004       --      in the nean time we have the Interrupt_Manager umnasked and
1005       --      the Server_Task waiting on sigwait.
1006
1007       --   2) For unbinding handler, we install a default action in the
1008       --      Interrupt_Manager. POSIX.1c states that the result of using
1009       --      "sigwait" and "sigaction" simaltaneously on the same interrupt
1010       --      is undefined. Therefore, we need to be informed from the
1011       --      Server_Task of the fact that the Server_Task is out of its
1012       --      sigwait stage.
1013
1014       IMOP.Empty_Interrupt_Mask (Intwait_Mask'Access);
1015       IMOP.Add_To_Interrupt_Mask
1016         (Intwait_Mask'Access, IMNG.Abort_Task_Interrupt);
1017       IMOP.Thread_Block_Interrupt
1018         (IMNG.Abort_Task_Interrupt);
1019
1020       loop
1021          --  A block is needed to absorb Program_Error exception
1022
1023          begin
1024             select
1025                accept Attach_Handler
1026                   (New_Handler : Parameterless_Handler;
1027                    Interrupt   : Interrupt_ID;
1028                    Static      : Boolean;
1029                    Restoration : Boolean := False)
1030                do
1031                   Unprotected_Exchange_Handler
1032                     (Old_Handler, New_Handler, Interrupt, Static, Restoration);
1033                end Attach_Handler;
1034
1035             or
1036                accept Exchange_Handler
1037                   (Old_Handler : out Parameterless_Handler;
1038                    New_Handler : Parameterless_Handler;
1039                    Interrupt   : Interrupt_ID;
1040                    Static      : Boolean)
1041                do
1042                   Unprotected_Exchange_Handler
1043                     (Old_Handler, New_Handler, Interrupt, Static);
1044                end Exchange_Handler;
1045
1046             or
1047                accept Detach_Handler
1048                  (Interrupt   : Interrupt_ID;
1049                   Static      : Boolean)
1050                do
1051                   Unprotected_Detach_Handler (Interrupt, Static);
1052                end Detach_Handler;
1053
1054             or
1055                accept Bind_Interrupt_To_Entry
1056                  (T       : Task_Id;
1057                   E       : Task_Entry_Index;
1058                   Interrupt : Interrupt_ID)
1059                do
1060                   --  if there is a binding already (either a procedure or an
1061                   --  entry), raise Program_Error (propagate it to the caller).
1062
1063                   if User_Handler (Interrupt).H /= null
1064                     or else User_Entry (Interrupt).T /= Null_Task
1065                   then
1066                      Raise_Exception (Program_Error'Identity,
1067                        "A binding for this interrupt is already present");
1068                   end if;
1069
1070                   --  The interrupt should no longer be ingnored if
1071                   --  it was ever ignored.
1072
1073                   Ignored (Interrupt) := False;
1074                   User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E);
1075
1076                   --  Indicate the attachment of Interrupt Entry in ATCB.
1077                   --  This is need so that when an Interrupt Entry task
1078                   --  terminates the binding can be cleaned. The call to
1079                   --  unbinding must be made by the task before it terminates.
1080
1081                   T.Interrupt_Entry := True;
1082
1083                   --  Invoke a corresponding Server_Task if not yet created.
1084                   --  Place Task_Id info in Server_ID array.
1085
1086                   if Server_ID (Interrupt) = Null_Task then
1087
1088                      --  When a new Server_Task is created, it should have its
1089                      --  signal mask set to the All_Tasks_Mask.
1090
1091                      IMOP.Set_Interrupt_Mask
1092                        (IMOP.All_Tasks_Mask'Access, Old_Mask'Access);
1093                      Access_Hold := new Server_Task (Interrupt);
1094                      IMOP.Set_Interrupt_Mask (Old_Mask'Access);
1095                      Server_ID (Interrupt) :=
1096                        To_System (Access_Hold.all'Identity);
1097                   end if;
1098
1099                   Bind_Handler (Interrupt);
1100                end Bind_Interrupt_To_Entry;
1101
1102             or
1103                accept Detach_Interrupt_Entries (T : Task_Id) do
1104                   for J in Interrupt_ID'Range loop
1105                      if not Is_Reserved (J) then
1106                         if User_Entry (J).T = T then
1107
1108                            --  The interrupt should no longer be ingnored if
1109                            --  it was ever ignored.
1110
1111                            Ignored (J) := False;
1112                            User_Entry (J) := Entry_Assoc'
1113                              (T => Null_Task, E => Null_Task_Entry);
1114                            Unbind_Handler (J);
1115                         end if;
1116                      end if;
1117                   end loop;
1118
1119                   --  Indicate in ATCB that no Interrupt Entries are attached
1120
1121                   T.Interrupt_Entry := False;
1122                end Detach_Interrupt_Entries;
1123
1124             or
1125                accept Block_Interrupt (Interrupt : Interrupt_ID) do
1126                   if Blocked (Interrupt) then
1127                      return;
1128                   end if;
1129
1130                   Blocked (Interrupt) := True;
1131                   Last_Unblocker (Interrupt) := Null_Task;
1132
1133                   --  Mask this task for the given Interrupt so that all tasks
1134                   --  are masked for the Interrupt.
1135
1136                   IMOP.Thread_Block_Interrupt (IMNG.Interrupt_ID (Interrupt));
1137
1138                   if User_Handler (Interrupt).H /= null
1139                     or else User_Entry (Interrupt).T /= Null_Task
1140                   then
1141                      --  This is the case where the Server_Task is waiting
1142                      --  on "sigwait." Wake it up by sending an
1143                      --  Abort_Task_Interrupt so that the Server_Task
1144                      --  waits on Cond.
1145
1146                      POP.Abort_Task (Server_ID (Interrupt));
1147
1148                      --  Make sure corresponding Server_Task is out of its own
1149                      --  sigwait state.
1150
1151                      Ret_Interrupt := Interrupt_ID
1152                        (IMOP.Interrupt_Wait (Intwait_Mask'Access));
1153                      pragma Assert
1154                        (Ret_Interrupt =
1155                         Interrupt_ID (IMNG.Abort_Task_Interrupt));
1156                   end if;
1157                end Block_Interrupt;
1158
1159             or
1160                accept Unblock_Interrupt (Interrupt : Interrupt_ID) do
1161                   if not Blocked (Interrupt) then
1162                      return;
1163                   end if;
1164
1165                   Blocked (Interrupt) := False;
1166                   Last_Unblocker (Interrupt) :=
1167                     To_System (Unblock_Interrupt'Caller);
1168
1169                   if User_Handler (Interrupt).H = null
1170                     and then User_Entry (Interrupt).T = Null_Task
1171                   then
1172                      --  No handler is attached. Unmask the Interrupt so that
1173                      --  the default action can be carried out.
1174
1175                      IMOP.Thread_Unblock_Interrupt
1176                        (IMNG.Interrupt_ID (Interrupt));
1177
1178                   else
1179                      --  The Server_Task must be waiting on the Cond variable
1180                      --  since it was being blocked and an Interrupt Hander or
1181                      --  an Entry was there. Wake it up and let it change
1182                      --  it place of waiting according to its new state.
1183
1184                      POP.Wakeup (Server_ID (Interrupt),
1185                        Interrupt_Server_Blocked_Interrupt_Sleep);
1186                   end if;
1187                end Unblock_Interrupt;
1188
1189             or
1190                accept Ignore_Interrupt (Interrupt : Interrupt_ID) do
1191                   if Ignored (Interrupt) then
1192                      return;
1193                   end if;
1194
1195                   Ignored (Interrupt) := True;
1196
1197                   --  If there is a handler associated with the Interrupt,
1198                   --  detach it first. In this way we make sure that the
1199                   --  Server_Task is not on sigwait. This is legal since
1200                   --  Unignore_Interrupt is to install the default action.
1201
1202                   if User_Handler (Interrupt).H /= null then
1203                      Unprotected_Detach_Handler
1204                        (Interrupt => Interrupt, Static => True);
1205
1206                   elsif User_Entry (Interrupt).T /= Null_Task then
1207                      User_Entry (Interrupt) := Entry_Assoc'
1208                        (T => Null_Task, E => Null_Task_Entry);
1209                      Unbind_Handler (Interrupt);
1210                   end if;
1211
1212                   IMOP.Install_Ignore_Action (IMNG.Interrupt_ID (Interrupt));
1213                end Ignore_Interrupt;
1214
1215             or
1216                accept Unignore_Interrupt (Interrupt : Interrupt_ID) do
1217                   Ignored (Interrupt) := False;
1218
1219                   --  If there is a handler associated with the Interrupt,
1220                   --  detach it first. In this way we make sure that the
1221                   --  Server_Task is not on sigwait. This is legal since
1222                   --  Unignore_Interrupt is to install the default action.
1223
1224                   if User_Handler (Interrupt).H /= null then
1225                      Unprotected_Detach_Handler
1226                        (Interrupt => Interrupt, Static => True);
1227
1228                   elsif User_Entry (Interrupt).T /= Null_Task then
1229                      User_Entry (Interrupt) := Entry_Assoc'
1230                        (T => Null_Task, E => Null_Task_Entry);
1231                      Unbind_Handler (Interrupt);
1232                   end if;
1233
1234                   IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
1235                end Unignore_Interrupt;
1236             end select;
1237
1238          exception
1239             --  If there is a program error we just want to propagate it to
1240             --  the caller and do not want to stop this task.
1241
1242             when Program_Error =>
1243                null;
1244
1245             when others =>
1246                pragma Assert (False);
1247                null;
1248          end;
1249       end loop;
1250    end Interrupt_Manager;
1251
1252    -----------------
1253    -- Server_Task --
1254    -----------------
1255
1256    task body Server_Task is
1257       Intwait_Mask    : aliased IMNG.Interrupt_Mask;
1258       Ret_Interrupt   : Interrupt_ID;
1259       Self_ID         : constant Task_Id := Self;
1260       Tmp_Handler     : Parameterless_Handler;
1261       Tmp_ID          : Task_Id;
1262       Tmp_Entry_Index : Task_Entry_Index;
1263
1264    begin
1265       --  By making this task independent of master, when the process
1266       --  goes away, the Server_Task will terminate gracefully.
1267
1268       System.Tasking.Utilities.Make_Independent;
1269
1270       --  Install default action in system level.
1271
1272       IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
1273
1274       --  Note: All tasks in RTS will have all the Reserve Interrupts
1275       --  being masked (except the Interrupt_Manager) and Keep_Unmasked
1276       --  unmasked when created.
1277
1278       --  Abort_Task_Interrupt is one of the Interrupt unmasked
1279       --  in all tasks. We mask the Interrupt in this particular task
1280       --  so that "sigwait" is possible to catch an explicitely sent
1281       --  Abort_Task_Interrupt from the Interrupt_Manager.
1282
1283       --  There are two Interrupt interrupts that this task catch through
1284       --  "sigwait." One is the Interrupt this task is designated to catch
1285       --  in order to execure user handler or entry. The other one is the
1286       --  Abort_Task_Interrupt. This interrupt is being sent from the
1287       --  Interrupt_Manager to inform status changes (e.g: become Blocked,
1288       --  Handler or Entry is to be detached).
1289
1290       --  Prepare a mask to used for sigwait.
1291
1292       IMOP.Empty_Interrupt_Mask (Intwait_Mask'Access);
1293
1294       IMOP.Add_To_Interrupt_Mask
1295         (Intwait_Mask'Access, IMNG.Interrupt_ID (Interrupt));
1296
1297       IMOP.Add_To_Interrupt_Mask
1298         (Intwait_Mask'Access, IMNG.Abort_Task_Interrupt);
1299
1300       IMOP.Thread_Block_Interrupt
1301         (IMNG.Abort_Task_Interrupt);
1302
1303       PIO.Set_Interrupt_ID (IMNG.Interrupt_ID (Interrupt), Self_ID);
1304
1305       loop
1306          System.Tasking.Initialization.Defer_Abort (Self_ID);
1307
1308          if Single_Lock then
1309             POP.Lock_RTS;
1310          end if;
1311
1312          POP.Write_Lock (Self_ID);
1313
1314          if User_Handler (Interrupt).H = null
1315            and then User_Entry (Interrupt).T = Null_Task
1316          then
1317             --  No Interrupt binding. If there is an interrupt,
1318             --  Interrupt_Manager will take default action.
1319
1320             Self_ID.Common.State := Interrupt_Server_Blocked_Interrupt_Sleep;
1321             POP.Sleep (Self_ID, Interrupt_Server_Idle_Sleep);
1322             Self_ID.Common.State := Runnable;
1323
1324          elsif Blocked (Interrupt) then
1325
1326             --  Interrupt is blocked. Stay here, so we won't catch
1327             --  the Interrupt.
1328
1329             Self_ID.Common.State := Interrupt_Server_Blocked_Interrupt_Sleep;
1330             POP.Sleep (Self_ID, Interrupt_Server_Blocked_Interrupt_Sleep);
1331             Self_ID.Common.State := Runnable;
1332
1333          else
1334             --  A Handler or an Entry is installed. At this point all tasks
1335             --  mask for the Interrupt is masked. Catch the Interrupt using
1336             --  sigwait.
1337
1338             --  This task may wake up from sigwait by receiving an interrupt
1339             --  (Abort_Task_Interrupt) from the Interrupt_Manager for unbinding
1340             --  a Procedure Handler or an Entry. Or it could be a wake up
1341             --  from status change (Unblocked -> Blocked). If that is not
1342             --  the case, we should exceute the attached Procedure or Entry.
1343
1344             Self_ID.Common.State := Interrupt_Server_Blocked_On_Event_Flag;
1345             POP.Unlock (Self_ID);
1346
1347             if Single_Lock then
1348                POP.Unlock_RTS;
1349             end if;
1350
1351             --  Avoid race condition when terminating application and
1352             --  System.Parameters.No_Abort is True.
1353
1354             if Parameters.No_Abort and then Self_ID.Pending_Action then
1355                Initialization.Do_Pending_Action (Self_ID);
1356             end if;
1357
1358             Ret_Interrupt :=
1359               Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access));
1360             Self_ID.Common.State := Runnable;
1361
1362             if Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt) then
1363
1364                --  Inform the Interrupt_Manager of wakeup from above sigwait.
1365
1366                POP.Abort_Task (Interrupt_Manager_ID);
1367
1368                if Single_Lock then
1369                   POP.Lock_RTS;
1370                end if;
1371
1372                POP.Write_Lock (Self_ID);
1373
1374             else
1375                if Single_Lock then
1376                   POP.Lock_RTS;
1377                end if;
1378
1379                POP.Write_Lock (Self_ID);
1380
1381                if Ret_Interrupt /= Interrupt then
1382
1383                   --  On some systems (e.g. recent linux kernels), sigwait
1384                   --  may return unexpectedly (with errno set to EINTR).
1385
1386                   null;
1387
1388                else
1389                   --  Even though we have received an Interrupt the status may
1390                   --  have changed already before we got the Self_ID lock above
1391                   --  Therefore we make sure a Handler or an Entry is still
1392                   --  there and make appropriate call.
1393
1394                   --  If there is no calls to make we need to regenerate the
1395                   --  Interrupt in order not to lose it.
1396
1397                   if User_Handler (Interrupt).H /= null then
1398                      Tmp_Handler := User_Handler (Interrupt).H;
1399
1400                      --  RTS calls should not be made with self being locked.
1401
1402                      POP.Unlock (Self_ID);
1403
1404                      if Single_Lock then
1405                         POP.Unlock_RTS;
1406                      end if;
1407
1408                      Tmp_Handler.all;
1409
1410                      if Single_Lock then
1411                         POP.Lock_RTS;
1412                      end if;
1413
1414                      POP.Write_Lock (Self_ID);
1415
1416                   elsif User_Entry (Interrupt).T /= Null_Task then
1417                      Tmp_ID := User_Entry (Interrupt).T;
1418                      Tmp_Entry_Index := User_Entry (Interrupt).E;
1419
1420                      --  RTS calls should not be made with self being locked.
1421
1422                      if Single_Lock then
1423                         POP.Unlock_RTS;
1424                      end if;
1425
1426                      POP.Unlock (Self_ID);
1427
1428                      System.Tasking.Rendezvous.Call_Simple
1429                        (Tmp_ID, Tmp_Entry_Index, System.Null_Address);
1430
1431                      POP.Write_Lock (Self_ID);
1432
1433                      if Single_Lock then
1434                         POP.Lock_RTS;
1435                      end if;
1436
1437                   else
1438                      --  This is a situation that this task wakes up receiving
1439                      --  an Interrupt and before it gets the lock the Interrupt
1440                      --  is blocked. We do not want to lose the interrupt in
1441                      --  this case so we regenerate the Interrupt to process
1442                      --  level.
1443
1444                      IMOP.Interrupt_Self_Process
1445                        (IMNG.Interrupt_ID (Interrupt));
1446                   end if;
1447                end if;
1448             end if;
1449          end if;
1450
1451          POP.Unlock (Self_ID);
1452
1453          if Single_Lock then
1454             POP.Unlock_RTS;
1455          end if;
1456
1457          System.Tasking.Initialization.Undefer_Abort (Self_ID);
1458
1459          if Self_ID.Pending_Action then
1460             Initialization.Do_Pending_Action (Self_ID);
1461          end if;
1462
1463          --  Undefer abort here to allow a window for this task to be aborted
1464          --  at the time of system shutdown. We also explicitely test for
1465          --  Pending_Action in case System.Parameters.No_Abort is True.
1466
1467       end loop;
1468    end Server_Task;
1469
1470 --  Elaboration code for package System.Interrupts
1471
1472 begin
1473    --  Get Interrupt_Manager's ID so that Abort_Interrupt can be sent.
1474
1475    Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
1476
1477    --  During the elaboration of this package body we want the RTS
1478    --  to inherit the interrupt mask from the Environment Task.
1479
1480    IMOP.Setup_Interrupt_Mask;
1481
1482    --  The environment task should have gotten its mask from the enclosing
1483    --  process during the RTS start up. (See processing in s-inmaop.adb). Pass
1484    --  the Interrupt_Mask of the environment task to the Interrupt_Manager.
1485
1486    --  Note: At this point we know that all tasks are masked for non-reserved
1487    --  signals. Only the Interrupt_Manager will have masks set up differently
1488    --  inheriting the original environment task's mask.
1489
1490    Interrupt_Manager.Initialize (IMOP.Environment_Mask);
1491 end System.Interrupts;