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-2006, 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 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 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 Volatile_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 Volatile_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 Volatile_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 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       begin
 766          if not Blocked (Interrupt) then
 767
 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             POP.Abort_Task (Server_ID (Interrupt));
 775
 776             --  Make sure corresponding Server_Task is out of its own
 777             --  sigwait state.
 778
 779             Ret_Interrupt :=
 780               Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access));
 781
 782             pragma Assert
 783               (Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt));
 784
 785             IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
 786
 787             --  Unmake the Interrupt for this task in order to allow default
 788             --  action again.
 789
 790             IMOP.Thread_Unblock_Interrupt (IMNG.Interrupt_ID (Interrupt));
 791
 792          else
 793             IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
 794          end if;
 795       end Unbind_Handler;
 796
 797       --------------------------------
 798       -- Unprotected_Detach_Handler --
 799       --------------------------------
 800
 801       procedure Unprotected_Detach_Handler
 802         (Interrupt   : Interrupt_ID;
 803          Static      : Boolean)
 804       is
 805          Old_Handler : Parameterless_Handler;
 806
 807       begin
 808          if User_Entry (Interrupt).T /= Null_Task then
 809
 810             --  In case we have an Interrupt Entry installed.
 811             --  raise a program error. (propagate it to the caller).
 812
 813             Raise_Exception (Program_Error'Identity,
 814               "An interrupt entry is already installed");
 815          end if;
 816
 817          --  Note : Static = True will pass the following check. That is the
 818          --  case when we want to detach a handler regardless of the static
 819          --  status of the current_Handler.
 820
 821          if not Static and then User_Handler (Interrupt).Static then
 822
 823             --  Tries to detach a static Interrupt Handler.
 824             --  raise a program error.
 825
 826             Raise_Exception (Program_Error'Identity,
 827               "Trying to detach a static Interrupt Handler");
 828          end if;
 829
 830          --  The interrupt should no longer be ignored if
 831          --  it was ever ignored.
 832
 833          Ignored (Interrupt) := False;
 834
 835          Old_Handler := User_Handler (Interrupt).H;
 836
 837          --  The new handler
 838
 839          User_Handler (Interrupt).H := null;
 840          User_Handler (Interrupt).Static := False;
 841
 842          if Old_Handler /= null then
 843             Unbind_Handler (Interrupt);
 844          end if;
 845       end Unprotected_Detach_Handler;
 846
 847       ----------------------------------
 848       -- Unprotected_Exchange_Handler --
 849       ----------------------------------
 850
 851       procedure Unprotected_Exchange_Handler
 852         (Old_Handler : out Parameterless_Handler;
 853          New_Handler : Parameterless_Handler;
 854          Interrupt   : Interrupt_ID;
 855          Static      : Boolean;
 856          Restoration : Boolean := False)
 857       is
 858       begin
 859          if User_Entry (Interrupt).T /= Null_Task then
 860
 861             --  In case we have an Interrupt Entry already installed.
 862             --  raise a program error. (propagate it to the caller).
 863
 864             Raise_Exception (Program_Error'Identity,
 865               "An interrupt is already installed");
 866          end if;
 867
 868          --  Note : A null handler with Static = True will pass the
 869          --  following check. That is the case when we want to Detach a
 870          --  handler regardless of the Static status of the current_Handler.
 871
 872          --  We don't check anything if Restoration is True, since we
 873          --  may be detaching a static handler to restore a dynamic one.
 874
 875          if not Restoration and then not Static
 876
 877             --  Tries to overwrite a static Interrupt Handler with a
 878             --  dynamic Handler
 879
 880            and then (User_Handler (Interrupt).Static
 881
 882                         --  The new handler is not specified as an
 883                         --  Interrupt Handler by a pragma.
 884
 885                         or else not Is_Registered (New_Handler))
 886          then
 887             Raise_Exception (Program_Error'Identity,
 888               "Trying to overwrite a static Interrupt Handler with a " &
 889               "dynamic Handler");
 890          end if;
 891
 892          --  The interrupt should no longer be ingnored if
 893          --  it was ever ignored.
 894
 895          Ignored (Interrupt) := False;
 896
 897          --  Save the old handler
 898
 899          Old_Handler := User_Handler (Interrupt).H;
 900
 901          --  The new handler
 902
 903          User_Handler (Interrupt).H := New_Handler;
 904
 905          if New_Handler = null then
 906
 907             --  The null handler means we are detaching the handler.
 908
 909             User_Handler (Interrupt).Static := False;
 910
 911          else
 912             User_Handler (Interrupt).Static := Static;
 913          end if;
 914
 915          --  Invoke a corresponding Server_Task if not yet created.
 916          --  Place Task_Id info in Server_ID array.
 917
 918          if Server_ID (Interrupt) = Null_Task then
 919
 920             --  When a new Server_Task is created, it should have its
 921             --  signal mask set to the All_Tasks_Mask.
 922
 923             IMOP.Set_Interrupt_Mask
 924               (IMOP.All_Tasks_Mask'Access, Old_Mask'Access);
 925             Access_Hold := new Server_Task (Interrupt);
 926             IMOP.Set_Interrupt_Mask (Old_Mask'Access);
 927
 928             Server_ID (Interrupt) := To_System (Access_Hold.all'Identity);
 929          end if;
 930
 931          if New_Handler = null then
 932             if Old_Handler /= null then
 933                Unbind_Handler (Interrupt);
 934             end if;
 935
 936             return;
 937          end if;
 938
 939          if Old_Handler = null then
 940             Bind_Handler (Interrupt);
 941          end if;
 942       end Unprotected_Exchange_Handler;
 943
 944    --  Start of processing for Interrupt_Manager
 945
 946    begin
 947       --  By making this task independent of master, when the process
 948       --  goes away, the Interrupt_Manager will terminate gracefully.
 949
 950       System.Tasking.Utilities.Make_Independent;
 951
 952       --  Environment task gets its own interrupt mask, saves it,
 953       --  and then masks all interrupts except the Keep_Unmasked set.
 954
 955       --  During rendezvous, the Interrupt_Manager receives the old
 956       --  interrupt mask of the environment task, and sets its own
 957       --  interrupt mask to that value.
 958
 959       --  The environment task will call the entry of Interrupt_Manager some
 960       --  during elaboration of the body of this package.
 961
 962       accept Initialize (Mask : IMNG.Interrupt_Mask) do
 963          declare
 964             The_Mask : aliased IMNG.Interrupt_Mask;
 965
 966          begin
 967             IMOP.Copy_Interrupt_Mask (The_Mask, Mask);
 968             IMOP.Set_Interrupt_Mask (The_Mask'Access);
 969          end;
 970       end Initialize;
 971
 972       --  Note: All tasks in RTS will have all the Reserve Interrupts
 973       --  being masked (except the Interrupt_Manager) and Keep_Unmasked
 974       --  unmasked when created.
 975
 976       --  Abort_Task_Interrupt is one of the Interrupt unmasked
 977       --  in all tasks. We mask the Interrupt in this particular task
 978       --  so that "sigwait" is possible to catch an explicitely sent
 979       --  Abort_Task_Interrupt from the Server_Tasks.
 980
 981       --  This sigwaiting is needed so that we make sure a Server_Task is
 982       --  out of its own sigwait state. This extra synchronization is
 983       --  necessary to prevent following senarios.
 984
 985       --   1) Interrupt_Manager sends an Abort_Task_Interrupt to the
 986       --      Server_Task then changes its own interrupt mask (OS level).
 987       --      If an interrupt (corresponding to the Server_Task) arrives
 988       --      in the nean time we have the Interrupt_Manager umnasked and
 989       --      the Server_Task waiting on sigwait.
 990
 991       --   2) For unbinding handler, we install a default action in the
 992       --      Interrupt_Manager. POSIX.1c states that the result of using
 993       --      "sigwait" and "sigaction" simaltaneously on the same interrupt
 994       --      is undefined. Therefore, we need to be informed from the
 995       --      Server_Task of the fact that the Server_Task is out of its
 996       --      sigwait stage.
 997
 998       IMOP.Empty_Interrupt_Mask (Intwait_Mask'Access);
 999       IMOP.Add_To_Interrupt_Mask
1000         (Intwait_Mask'Access, IMNG.Abort_Task_Interrupt);
1001       IMOP.Thread_Block_Interrupt
1002         (IMNG.Abort_Task_Interrupt);
1003
1004       loop
1005          --  A block is needed to absorb Program_Error exception
1006
1007          begin
1008             select
1009                accept Attach_Handler
1010                   (New_Handler : Parameterless_Handler;
1011                    Interrupt   : Interrupt_ID;
1012                    Static      : Boolean;
1013                    Restoration : Boolean := False)
1014                do
1015                   Unprotected_Exchange_Handler
1016                     (Old_Handler, New_Handler, Interrupt, Static, Restoration);
1017                end Attach_Handler;
1018
1019             or
1020                accept Exchange_Handler
1021                   (Old_Handler : out Parameterless_Handler;
1022                    New_Handler : Parameterless_Handler;
1023                    Interrupt   : Interrupt_ID;
1024                    Static      : Boolean)
1025                do
1026                   Unprotected_Exchange_Handler
1027                     (Old_Handler, New_Handler, Interrupt, Static);
1028                end Exchange_Handler;
1029
1030             or
1031                accept Detach_Handler
1032                  (Interrupt   : Interrupt_ID;
1033                   Static      : Boolean)
1034                do
1035                   Unprotected_Detach_Handler (Interrupt, Static);
1036                end Detach_Handler;
1037
1038             or
1039                accept Bind_Interrupt_To_Entry
1040                  (T       : Task_Id;
1041                   E       : Task_Entry_Index;
1042                   Interrupt : Interrupt_ID)
1043                do
1044                   --  if there is a binding already (either a procedure or an
1045                   --  entry), raise Program_Error (propagate it to the caller).
1046
1047                   if User_Handler (Interrupt).H /= null
1048                     or else User_Entry (Interrupt).T /= Null_Task
1049                   then
1050                      Raise_Exception (Program_Error'Identity,
1051                        "A binding for this interrupt is already present");
1052                   end if;
1053
1054                   --  The interrupt should no longer be ingnored if
1055                   --  it was ever ignored.
1056
1057                   Ignored (Interrupt) := False;
1058                   User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E);
1059
1060                   --  Indicate the attachment of Interrupt Entry in ATCB.
1061                   --  This is need so that when an Interrupt Entry task
1062                   --  terminates the binding can be cleaned. The call to
1063                   --  unbinding must be made by the task before it terminates.
1064
1065                   T.Interrupt_Entry := True;
1066
1067                   --  Invoke a corresponding Server_Task if not yet created.
1068                   --  Place Task_Id info in Server_ID array.
1069
1070                   if Server_ID (Interrupt) = Null_Task then
1071
1072                      --  When a new Server_Task is created, it should have its
1073                      --  signal mask set to the All_Tasks_Mask.
1074
1075                      IMOP.Set_Interrupt_Mask
1076                        (IMOP.All_Tasks_Mask'Access, Old_Mask'Access);
1077                      Access_Hold := new Server_Task (Interrupt);
1078                      IMOP.Set_Interrupt_Mask (Old_Mask'Access);
1079                      Server_ID (Interrupt) :=
1080                        To_System (Access_Hold.all'Identity);
1081                   end if;
1082
1083                   Bind_Handler (Interrupt);
1084                end Bind_Interrupt_To_Entry;
1085
1086             or
1087                accept Detach_Interrupt_Entries (T : Task_Id) do
1088                   for J in Interrupt_ID'Range loop
1089                      if not Is_Reserved (J) then
1090                         if User_Entry (J).T = T then
1091
1092                            --  The interrupt should no longer be ingnored if
1093                            --  it was ever ignored.
1094
1095                            Ignored (J) := False;
1096                            User_Entry (J) := Entry_Assoc'
1097                              (T => Null_Task, E => Null_Task_Entry);
1098                            Unbind_Handler (J);
1099                         end if;
1100                      end if;
1101                   end loop;
1102
1103                   --  Indicate in ATCB that no Interrupt Entries are attached
1104
1105                   T.Interrupt_Entry := False;
1106                end Detach_Interrupt_Entries;
1107
1108             or
1109                accept Block_Interrupt (Interrupt : Interrupt_ID) do
1110                   if Blocked (Interrupt) then
1111                      return;
1112                   end if;
1113
1114                   Blocked (Interrupt) := True;
1115                   Last_Unblocker (Interrupt) := Null_Task;
1116
1117                   --  Mask this task for the given Interrupt so that all tasks
1118                   --  are masked for the Interrupt.
1119
1120                   IMOP.Thread_Block_Interrupt (IMNG.Interrupt_ID (Interrupt));
1121
1122                   if User_Handler (Interrupt).H /= null
1123                     or else  User_Entry (Interrupt).T /= Null_Task
1124                   then
1125                      --  This is the case where the Server_Task is waiting
1126                      --  on "sigwait." Wake it up by sending an
1127                      --  Abort_Task_Interrupt so that the Server_Task
1128                      --  waits on Cond.
1129
1130                      POP.Abort_Task (Server_ID (Interrupt));
1131
1132                      --  Make sure corresponding Server_Task is out of its own
1133                      --  sigwait state.
1134
1135                      Ret_Interrupt := Interrupt_ID
1136                        (IMOP.Interrupt_Wait (Intwait_Mask'Access));
1137                      pragma Assert
1138                        (Ret_Interrupt =
1139                         Interrupt_ID (IMNG.Abort_Task_Interrupt));
1140                   end if;
1141                end Block_Interrupt;
1142
1143             or
1144                accept Unblock_Interrupt (Interrupt : Interrupt_ID) do
1145                   if not Blocked (Interrupt) then
1146                      return;
1147                   end if;
1148
1149                   Blocked (Interrupt) := False;
1150                   Last_Unblocker (Interrupt) :=
1151                     To_System (Unblock_Interrupt'Caller);
1152
1153                   if User_Handler (Interrupt).H = null
1154                     and then User_Entry (Interrupt).T = Null_Task
1155                   then
1156                      --  No handler is attached. Unmask the Interrupt so that
1157                      --  the default action can be carried out.
1158
1159                      IMOP.Thread_Unblock_Interrupt
1160                        (IMNG.Interrupt_ID (Interrupt));
1161
1162                   else
1163                      --  The Server_Task must be waiting on the Cond variable
1164                      --  since it was being blocked and an Interrupt Hander or
1165                      --  an Entry was there. Wake it up and let it change
1166                      --  it place of waiting according to its new state.
1167
1168                      POP.Wakeup (Server_ID (Interrupt),
1169                        Interrupt_Server_Blocked_Interrupt_Sleep);
1170                   end if;
1171                end Unblock_Interrupt;
1172
1173             or
1174                accept Ignore_Interrupt (Interrupt : Interrupt_ID) do
1175                   if Ignored (Interrupt) then
1176                      return;
1177                   end if;
1178
1179                   Ignored (Interrupt) := True;
1180
1181                   --  If there is a handler associated with the Interrupt,
1182                   --  detach it first. In this way we make sure that the
1183                   --  Server_Task is not on sigwait. This is legal since
1184                   --  Unignore_Interrupt is to install the default action.
1185
1186                   if User_Handler (Interrupt).H /= null then
1187                      Unprotected_Detach_Handler
1188                        (Interrupt => Interrupt, Static => True);
1189
1190                   elsif User_Entry (Interrupt).T /= Null_Task then
1191                      User_Entry (Interrupt) := Entry_Assoc'
1192                        (T => Null_Task, E => Null_Task_Entry);
1193                      Unbind_Handler (Interrupt);
1194                   end if;
1195
1196                   IMOP.Install_Ignore_Action (IMNG.Interrupt_ID (Interrupt));
1197                end Ignore_Interrupt;
1198
1199             or
1200                accept Unignore_Interrupt (Interrupt : Interrupt_ID) do
1201                   Ignored (Interrupt) := False;
1202
1203                   --  If there is a handler associated with the Interrupt,
1204                   --  detach it first. In this way we make sure that the
1205                   --  Server_Task is not on sigwait. This is legal since
1206                   --  Unignore_Interrupt is to install the default action.
1207
1208                   if User_Handler (Interrupt).H /= null then
1209                      Unprotected_Detach_Handler
1210                        (Interrupt => Interrupt, Static => True);
1211
1212                   elsif User_Entry (Interrupt).T /= Null_Task then
1213                      User_Entry (Interrupt) := Entry_Assoc'
1214                        (T => Null_Task, E => Null_Task_Entry);
1215                      Unbind_Handler (Interrupt);
1216                   end if;
1217
1218                   IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
1219                end Unignore_Interrupt;
1220             end select;
1221
1222          exception
1223             --  If there is a program error we just want to propagate it to
1224             --  the caller and do not want to stop this task.
1225
1226             when Program_Error =>
1227                null;
1228
1229             when others =>
1230                pragma Assert (False);
1231                null;
1232          end;
1233       end loop;
1234    end Interrupt_Manager;
1235
1236    -----------------
1237    -- Server_Task --
1238    -----------------
1239
1240    task body Server_Task is
1241       Intwait_Mask    : aliased IMNG.Interrupt_Mask;
1242       Ret_Interrupt   : Interrupt_ID;
1243       Self_ID         : constant Task_Id := Self;
1244       Tmp_Handler     : Parameterless_Handler;
1245       Tmp_ID          : Task_Id;
1246       Tmp_Entry_Index : Task_Entry_Index;
1247
1248    begin
1249       --  By making this task independent of master, when the process
1250       --  goes away, the Server_Task will terminate gracefully.
1251
1252       System.Tasking.Utilities.Make_Independent;
1253
1254       --  Install default action in system level.
1255
1256       IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
1257
1258       --  Note: All tasks in RTS will have all the Reserve Interrupts
1259       --  being masked (except the Interrupt_Manager) and Keep_Unmasked
1260       --  unmasked when created.
1261
1262       --  Abort_Task_Interrupt is one of the Interrupt unmasked
1263       --  in all tasks. We mask the Interrupt in this particular task
1264       --  so that "sigwait" is possible to catch an explicitely sent
1265       --  Abort_Task_Interrupt from the Interrupt_Manager.
1266
1267       --  There are two Interrupt interrupts that this task catch through
1268       --  "sigwait." One is the Interrupt this task is designated to catch
1269       --  in order to execure user handler or entry. The other one is the
1270       --  Abort_Task_Interrupt. This interrupt is being sent from the
1271       --  Interrupt_Manager to inform status changes (e.g: become Blocked,
1272       --  Handler or Entry is to be detached).
1273
1274       --  Prepare a mask to used for sigwait.
1275
1276       IMOP.Empty_Interrupt_Mask (Intwait_Mask'Access);
1277
1278       IMOP.Add_To_Interrupt_Mask
1279         (Intwait_Mask'Access, IMNG.Interrupt_ID (Interrupt));
1280
1281       IMOP.Add_To_Interrupt_Mask
1282         (Intwait_Mask'Access, IMNG.Abort_Task_Interrupt);
1283
1284       IMOP.Thread_Block_Interrupt
1285         (IMNG.Abort_Task_Interrupt);
1286
1287       PIO.Set_Interrupt_ID (IMNG.Interrupt_ID (Interrupt), Self_ID);
1288
1289       loop
1290          System.Tasking.Initialization.Defer_Abort (Self_ID);
1291
1292          if Single_Lock then
1293             POP.Lock_RTS;
1294          end if;
1295
1296          POP.Write_Lock (Self_ID);
1297
1298          if User_Handler (Interrupt).H = null
1299            and then User_Entry (Interrupt).T = Null_Task
1300          then
1301             --  No Interrupt binding. If there is an interrupt,
1302             --  Interrupt_Manager will take default action.
1303
1304             Self_ID.Common.State := Interrupt_Server_Blocked_Interrupt_Sleep;
1305             POP.Sleep (Self_ID, Interrupt_Server_Idle_Sleep);
1306             Self_ID.Common.State := Runnable;
1307
1308          elsif Blocked (Interrupt) then
1309
1310             --  Interrupt is blocked. Stay here, so we won't catch
1311             --  the Interrupt.
1312
1313             Self_ID.Common.State := Interrupt_Server_Blocked_Interrupt_Sleep;
1314             POP.Sleep (Self_ID, Interrupt_Server_Blocked_Interrupt_Sleep);
1315             Self_ID.Common.State := Runnable;
1316
1317          else
1318             --  A Handler or an Entry is installed. At this point all tasks
1319             --  mask for the Interrupt is masked. Catch the Interrupt using
1320             --  sigwait.
1321
1322             --  This task may wake up from sigwait by receiving an interrupt
1323             --  (Abort_Task_Interrupt) from the Interrupt_Manager for unbinding
1324             --  a Procedure Handler or an Entry. Or it could be a wake up
1325             --  from status change (Unblocked -> Blocked). If that is not
1326             --  the case, we should exceute the attached Procedure or Entry.
1327
1328             POP.Unlock (Self_ID);
1329
1330             if Single_Lock then
1331                POP.Unlock_RTS;
1332             end if;
1333
1334             Ret_Interrupt :=
1335               Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access));
1336
1337             if Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt) then
1338
1339                --  Inform the Interrupt_Manager of wakeup from above sigwait.
1340
1341                POP.Abort_Task (Interrupt_Manager_ID);
1342
1343                if Single_Lock then
1344                   POP.Lock_RTS;
1345                end if;
1346
1347                POP.Write_Lock (Self_ID);
1348
1349             else
1350                if Single_Lock then
1351                   POP.Lock_RTS;
1352                end if;
1353
1354                POP.Write_Lock (Self_ID);
1355
1356                if Ret_Interrupt /= Interrupt then
1357
1358                   --  On some systems (e.g. recent linux kernels), sigwait
1359                   --  may return unexpectedly (with errno set to EINTR).
1360
1361                   null;
1362
1363                else
1364                   --  Even though we have received an Interrupt the status may
1365                   --  have changed already before we got the Self_ID lock above
1366                   --  Therefore we make sure a Handler or an Entry is still
1367                   --  there and make appropriate call.
1368
1369                   --  If there is no calls to make we need to regenerate the
1370                   --  Interrupt in order not to lose it.
1371
1372                   if User_Handler (Interrupt).H /= null then
1373                      Tmp_Handler := User_Handler (Interrupt).H;
1374
1375                      --  RTS calls should not be made with self being locked.
1376
1377                      POP.Unlock (Self_ID);
1378
1379                      if Single_Lock then
1380                         POP.Unlock_RTS;
1381                      end if;
1382
1383                      Tmp_Handler.all;
1384
1385                      if Single_Lock then
1386                         POP.Lock_RTS;
1387                      end if;
1388
1389                      POP.Write_Lock (Self_ID);
1390
1391                   elsif User_Entry (Interrupt).T /= Null_Task then
1392                      Tmp_ID := User_Entry (Interrupt).T;
1393                      Tmp_Entry_Index := User_Entry (Interrupt).E;
1394
1395                      --  RTS calls should not be made with self being locked.
1396
1397                      if Single_Lock then
1398                         POP.Unlock_RTS;
1399                      end if;
1400
1401                      POP.Unlock (Self_ID);
1402
1403                      System.Tasking.Rendezvous.Call_Simple
1404                        (Tmp_ID, Tmp_Entry_Index, System.Null_Address);
1405
1406                      POP.Write_Lock (Self_ID);
1407
1408                      if Single_Lock then
1409                         POP.Lock_RTS;
1410                      end if;
1411
1412                   else
1413                      --  This is a situation that this task wakes up receiving
1414                      --  an Interrupt and before it gets the lock the Interrupt
1415                      --  is blocked. We do not want to lose the interrupt in
1416                      --  this case so we regenerate the Interrupt to process
1417                      --  level.
1418
1419                      IMOP.Interrupt_Self_Process
1420                        (IMNG.Interrupt_ID (Interrupt));
1421                   end if;
1422                end if;
1423             end if;
1424          end if;
1425
1426          POP.Unlock (Self_ID);
1427
1428          if Single_Lock then
1429             POP.Unlock_RTS;
1430          end if;
1431
1432          System.Tasking.Initialization.Undefer_Abort (Self_ID);
1433
1434          if Self_ID.Pending_Action then
1435             Initialization.Do_Pending_Action (Self_ID);
1436          end if;
1437
1438          --  Undefer abort here to allow a window for this task to be aborted
1439          --  at the time of system shutdown. We also explicitely test for
1440          --  Pending_Action in case System.Parameters.No_Abort is True.
1441
1442       end loop;
1443    end Server_Task;
1444
1445 --  Elaboration code for package System.Interrupts
1446
1447 begin
1448    --  Get Interrupt_Manager's ID so that Abort_Interrupt can be sent.
1449
1450    Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
1451
1452    --  During the elaboration of this package body we want the RTS
1453    --  to inherit the interrupt mask from the Environment Task.
1454
1455    IMOP.Setup_Interrupt_Mask;
1456
1457    --  The environment task should have gotten its mask from the enclosing
1458    --  process during the RTS start up. (See processing in s-inmaop.adb). Pass
1459    --  the Interrupt_Mask of the environment task to the Interrupt_Manager.
1460
1461    --  Note : At this point we know that all tasks are masked for non-reserved
1462    --  signals. Only the Interrupt_Manager will have masks set up differently
1463    --  inheriting the original environment task's mask.
1464
1465    Interrupt_Manager.Initialize (IMOP.Environment_Mask);
1466 end System.Interrupts;