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