gcc/ada/libgnarl/s-interr__hwint.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-2018, 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-handlable signals are masked at all times in all tasks/threads
  35 --  except possibly for the Interrupt_Manager task.
  36
  37 --  When a user task wants to have the effect of masking/unmasking an signal,
  38 --  it must call Block_Interrupt/Unblock_Interrupt, which will have the effect
  39 --  of unmasking/masking the signal in the Interrupt_Manager task. These
  40 --  comments do not apply to vectored hardware interrupts, which may be masked
  41 --  or unmasked using routined interfaced to the relevant embedded RTOS system
  42 --  calls.
  43
  44 --  Once we associate a Signal_Server_Task with an signal, the task never goes
  45 --  away, and we never remove the association. On the other hand, it is more
  46 --  convenient to terminate an associated Interrupt_Server_Task for a vectored
  47 --  hardware interrupt (since we use a binary semaphore for synchronization
  48 --  with the umbrella handler).
  49
  50 --  There is no more than one signal per Signal_Server_Task and no more than
  51 --  one Signal_Server_Task per signal. The same relation holds for hardware
  52 --  interrupts and Interrupt_Server_Task's at any given time. That is, only
  53 --  one non-terminated Interrupt_Server_Task exists for a give interrupt at
  54 --  any time.
  55
  56 --  Within this package, the lock L is used to protect the various status
  57 --  tables. If there is a Server_Task associated with a signal or interrupt,
  58 --  we use the per-task lock of the Server_Task instead so that we protect the
  59 --  status between Interrupt_Manager and Server_Task. Protection among service
  60 --  requests are ensured via user calls to the Interrupt_Manager entries.
  61
  62 --  This is reasonably generic version of this package, supporting vectored
  63 --  hardware interrupts using non-RTOS specific adapter routines which should
  64 --  easily implemented on any RTOS capable of supporting GNAT.
  65
  66 with Ada.Unchecked_Conversion;
  67 with Ada.Task_Identification;
  68
  69 with Interfaces.C; use Interfaces.C;
  70 with System.OS_Interface; use System.OS_Interface;
  71 with System.Interrupt_Management;
  72 with System.Task_Primitives.Operations;
  73 with System.Storage_Elements;
  74 with System.Tasking.Utilities;
  75
  76 with System.Tasking.Rendezvous;
  77 pragma Elaborate_All (System.Tasking.Rendezvous);
  78
  79 package body System.Interrupts is
  80
  81    use Tasking;
  82
  83    package POP renames System.Task_Primitives.Operations;
  84
  85    function To_Ada is new Ada.Unchecked_Conversion
  86      (System.Tasking.Task_Id, Ada.Task_Identification.Task_Id);
  87
  88    function To_System is new Ada.Unchecked_Conversion
  89      (Ada.Task_Identification.Task_Id, Task_Id);
  90
  91    -----------------
  92    -- Local Tasks --
  93    -----------------
  94
  95    --  WARNING: System.Tasking.Stages performs calls to this task with low-
  96    --  level constructs. Do not change this spec without synchronizing it.
  97
  98    task Interrupt_Manager is
  99       entry Detach_Interrupt_Entries (T : Task_Id);
 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       pragma Interrupt_Priority (System.Interrupt_Priority'First);
 123    end Interrupt_Manager;
 124
 125    task type Interrupt_Server_Task
 126      (Interrupt : Interrupt_ID;
 127       Int_Sema  : Binary_Semaphore_Id)
 128    is
 129       --  Server task for vectored hardware interrupt handling
 130
 131       pragma Interrupt_Priority (System.Interrupt_Priority'First + 2);
 132    end Interrupt_Server_Task;
 133
 134    type Interrupt_Task_Access is access Interrupt_Server_Task;
 135
 136    -------------------------------
 137    -- Local Types and Variables --
 138    -------------------------------
 139
 140    type Entry_Assoc is record
 141       T : Task_Id;
 142       E : Task_Entry_Index;
 143    end record;
 144
 145    type Handler_Assoc is record
 146       H      : Parameterless_Handler;
 147       Static : Boolean;   --  Indicates static binding;
 148    end record;
 149
 150    User_Handler : array (Interrupt_ID) of Handler_Assoc :=
 151      (others => (null, Static => False));
 152    pragma Volatile_Components (User_Handler);
 153    --  Holds the protected procedure handler (if any) and its Static
 154    --  information for each interrupt or signal. A handler is static iff it
 155    --  is specified through the pragma Attach_Handler.
 156
 157    User_Entry : array (Interrupt_ID) of Entry_Assoc :=
 158                   (others => (T => Null_Task, E => Null_Task_Entry));
 159    pragma Volatile_Components (User_Entry);
 160    --  Holds the task and entry index (if any) for each interrupt / signal
 161
 162    --  Type and Head, Tail of the list containing Registered Interrupt
 163    --  Handlers. These definitions are used to register the handlers
 164    --  specified by the pragma Interrupt_Handler.
 165
 166    type Registered_Handler;
 167    type R_Link is access all Registered_Handler;
 168
 169    type Registered_Handler is record
 170       H    : System.Address := System.Null_Address;
 171       Next : R_Link := null;
 172    end record;
 173
 174    Registered_Handler_Head : R_Link := null;
 175    Registered_Handler_Tail : R_Link := null;
 176
 177    Server_ID : array (Interrupt_ID) of System.Tasking.Task_Id :=
 178                  (others => System.Tasking.Null_Task);
 179    pragma Atomic_Components (Server_ID);
 180    --  Holds the Task_Id of the Server_Task for each interrupt / signal.
 181    --  Task_Id is needed to accomplish locking per interrupt base. Also
 182    --  is needed to determine whether to create a new Server_Task.
 183
 184    Semaphore_ID_Map : array
 185      (Interrupt_ID range 0 .. System.OS_Interface.Max_HW_Interrupt) of
 186         Binary_Semaphore_Id := (others => 0);
 187    --  Array of binary semaphores associated with vectored interrupts. Note
 188    --  that the last bound should be Max_HW_Interrupt, but this will raise
 189    --  Storage_Error if Num_HW_Interrupts is null so use extra 4 bytes instead.
 190
 191    Interrupt_Access_Hold : Interrupt_Task_Access;
 192    --  Variable for allocating an Interrupt_Server_Task
 193
 194    Handler_Installed : array (HW_Interrupt) of Boolean := (others => False);
 195    --  True if Notify_Interrupt was connected to the interrupt. Handlers can
 196    --  be connected but disconnection is not possible on VxWorks. Therefore
 197    --  we ensure Notify_Installed is connected at most once.
 198
 199    -----------------------
 200    -- Local Subprograms --
 201    -----------------------
 202
 203    procedure Check_Reserved_Interrupt (Interrupt : Interrupt_ID);
 204    --  Check if Id is a reserved interrupt, and if so raise Program_Error
 205    --  with an appropriate message, otherwise return.
 206
 207    procedure Finalize_Interrupt_Servers;
 208    --  Unbind the handlers for hardware interrupt server tasks at program
 209    --  termination.
 210
 211    function Is_Registered (Handler : Parameterless_Handler) return Boolean;
 212    --  See if Handler has been "pragma"ed using Interrupt_Handler.
 213    --  Always consider a null handler as registered.
 214
 215    procedure Notify_Interrupt (Param : System.Address);
 216    pragma Convention (C, Notify_Interrupt);
 217    --  Umbrella handler for vectored interrupts (not signals)
 218
 219    procedure Install_Umbrella_Handler
 220      (Interrupt : HW_Interrupt;
 221       Handler   : System.OS_Interface.Interrupt_Handler);
 222    --  Install the runtime umbrella handler for a vectored hardware
 223    --  interrupt
 224
 225    procedure Unimplemented (Feature : String);
 226    pragma No_Return (Unimplemented);
 227    --  Used to mark a call to an unimplemented function. Raises Program_Error
 228    --  with an appropriate message noting that Feature is unimplemented.
 229
 230    --------------------
 231    -- Attach_Handler --
 232    --------------------
 233
 234    --  Calling this procedure with New_Handler = null and Static = True
 235    --  means we want to detach the current handler regardless of the previous
 236    --  handler's binding status (i.e. do not care if it is a dynamic or static
 237    --  handler).
 238
 239    --  This option is needed so that during the finalization of a PO, we can
 240    --  detach handlers attached through pragma Attach_Handler.
 241
 242    procedure Attach_Handler
 243      (New_Handler : Parameterless_Handler;
 244       Interrupt   : Interrupt_ID;
 245       Static      : Boolean := False) is
 246    begin
 247       Check_Reserved_Interrupt (Interrupt);
 248       Interrupt_Manager.Attach_Handler (New_Handler, Interrupt, Static);
 249    end Attach_Handler;
 250
 251    -----------------------------
 252    -- Bind_Interrupt_To_Entry --
 253    -----------------------------
 254
 255    --  This procedure raises a Program_Error if it tries to
 256    --  bind an interrupt to which an Entry or a Procedure is
 257    --  already bound.
 258
 259    procedure Bind_Interrupt_To_Entry
 260      (T       : Task_Id;
 261       E       : Task_Entry_Index;
 262       Int_Ref : System.Address)
 263    is
 264       Interrupt : constant Interrupt_ID :=
 265                     Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
 266    begin
 267       Check_Reserved_Interrupt (Interrupt);
 268       Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt);
 269    end Bind_Interrupt_To_Entry;
 270
 271    ---------------------
 272    -- Block_Interrupt --
 273    ---------------------
 274
 275    procedure Block_Interrupt (Interrupt : Interrupt_ID) is
 276    begin
 277       Unimplemented ("Block_Interrupt");
 278    end Block_Interrupt;
 279
 280    ------------------------------
 281    -- Check_Reserved_Interrupt --
 282    ------------------------------
 283
 284    procedure Check_Reserved_Interrupt (Interrupt : Interrupt_ID) is
 285    begin
 286       if Is_Reserved (Interrupt) then
 287          raise Program_Error with
 288            "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
 289       else
 290          return;
 291       end if;
 292    end Check_Reserved_Interrupt;
 293
 294    ---------------------
 295    -- Current_Handler --
 296    ---------------------
 297
 298    function Current_Handler
 299      (Interrupt : Interrupt_ID) return Parameterless_Handler
 300    is
 301    begin
 302       Check_Reserved_Interrupt (Interrupt);
 303
 304       --  ??? Since Parameterless_Handler is not Atomic, the current
 305       --  implementation is wrong. We need a new service in Interrupt_Manager
 306       --  to ensure atomicity.
 307
 308       return User_Handler (Interrupt).H;
 309    end Current_Handler;
 310
 311    --------------------
 312    -- Detach_Handler --
 313    --------------------
 314
 315    --  Calling this procedure with Static = True means we want to Detach the
 316    --  current handler regardless of the previous handler's binding status
 317    --  (i.e. do not care if it is a dynamic or static handler).
 318
 319    --  This option is needed so that during the finalization of a PO, we can
 320    --  detach handlers attached through pragma Attach_Handler.
 321
 322    procedure Detach_Handler
 323      (Interrupt : Interrupt_ID;
 324       Static    : Boolean := False)
 325    is
 326    begin
 327       Check_Reserved_Interrupt (Interrupt);
 328       Interrupt_Manager.Detach_Handler (Interrupt, Static);
 329    end Detach_Handler;
 330
 331    ------------------------------
 332    -- Detach_Interrupt_Entries --
 333    ------------------------------
 334
 335    procedure Detach_Interrupt_Entries (T : Task_Id) is
 336    begin
 337       Interrupt_Manager.Detach_Interrupt_Entries (T);
 338    end Detach_Interrupt_Entries;
 339
 340    ----------------------
 341    -- Exchange_Handler --
 342    ----------------------
 343
 344    --  Calling this procedure with New_Handler = null and Static = True
 345    --  means we want to detach the current handler regardless of the previous
 346    --  handler's binding status (i.e. we do not care if it is a dynamic or
 347    --  static handler).
 348
 349    --  This option is needed so that during the finalization of a PO, we can
 350    --  detach handlers attached through pragma Attach_Handler.
 351
 352    procedure Exchange_Handler
 353      (Old_Handler : out Parameterless_Handler;
 354       New_Handler : Parameterless_Handler;
 355       Interrupt   : Interrupt_ID;
 356       Static      : Boolean := False)
 357    is
 358    begin
 359       Check_Reserved_Interrupt (Interrupt);
 360       Interrupt_Manager.Exchange_Handler
 361         (Old_Handler, New_Handler, Interrupt, Static);
 362    end Exchange_Handler;
 363
 364    --------------
 365    -- Finalize --
 366    --------------
 367
 368    procedure Finalize (Object : in out Static_Interrupt_Protection) is
 369    begin
 370       --  ??? loop to be executed only when we're not doing library level
 371       --  finalization, since in this case all interrupt / signal tasks are
 372       --  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    -- Finalize_Interrupt_Servers --
 390    --------------------------------
 391
 392    --  Restore default handlers for interrupt servers
 393
 394    --  This is called by the Interrupt_Manager task when it receives the abort
 395    --  signal during program finalization.
 396
 397    procedure Finalize_Interrupt_Servers is
 398       HW_Interrupts : constant Boolean := HW_Interrupt'Last >= 0;
 399    begin
 400       if HW_Interrupts then
 401          for Int in HW_Interrupt loop
 402             if Server_ID (Interrupt_ID (Int)) /= null
 403               and then
 404                 not Ada.Task_Identification.Is_Terminated
 405                  (To_Ada (Server_ID (Interrupt_ID (Int))))
 406             then
 407                Interrupt_Manager.Attach_Handler
 408                  (New_Handler => null,
 409                   Interrupt   => Interrupt_ID (Int),
 410                   Static      => True,
 411                   Restoration => True);
 412             end if;
 413          end loop;
 414       end if;
 415    end Finalize_Interrupt_Servers;
 416
 417    -------------------------------------
 418    -- Has_Interrupt_Or_Attach_Handler --
 419    -------------------------------------
 420
 421    function Has_Interrupt_Or_Attach_Handler
 422      (Object : access Dynamic_Interrupt_Protection)
 423       return   Boolean
 424    is
 425       pragma Unreferenced (Object);
 426    begin
 427       return True;
 428    end Has_Interrupt_Or_Attach_Handler;
 429
 430    function Has_Interrupt_Or_Attach_Handler
 431      (Object : access Static_Interrupt_Protection)
 432       return   Boolean
 433    is
 434       pragma Unreferenced (Object);
 435    begin
 436       return True;
 437    end Has_Interrupt_Or_Attach_Handler;
 438
 439    ----------------------
 440    -- Ignore_Interrupt --
 441    ----------------------
 442
 443    procedure Ignore_Interrupt (Interrupt : Interrupt_ID) is
 444    begin
 445       Unimplemented ("Ignore_Interrupt");
 446    end Ignore_Interrupt;
 447
 448    ----------------------
 449    -- Install_Handlers --
 450    ----------------------
 451
 452    procedure Install_Handlers
 453      (Object       : access Static_Interrupt_Protection;
 454       New_Handlers : New_Handler_Array)
 455    is
 456    begin
 457       for N in New_Handlers'Range loop
 458
 459          --  We need a lock around this ???
 460
 461          Object.Previous_Handlers (N).Interrupt := New_Handlers (N).Interrupt;
 462          Object.Previous_Handlers (N).Static    := User_Handler
 463            (New_Handlers (N).Interrupt).Static;
 464
 465          --  We call Exchange_Handler and not directly Interrupt_Manager.
 466          --  Exchange_Handler so we get the Is_Reserved check.
 467
 468          Exchange_Handler
 469            (Old_Handler => Object.Previous_Handlers (N).Handler,
 470             New_Handler => New_Handlers (N).Handler,
 471             Interrupt   => New_Handlers (N).Interrupt,
 472             Static      => True);
 473       end loop;
 474    end Install_Handlers;
 475
 476    ---------------------------------
 477    -- Install_Restricted_Handlers --
 478    ---------------------------------
 479
 480    procedure Install_Restricted_Handlers
 481       (Prio     : Any_Priority;
 482        Handlers : New_Handler_Array)
 483    is
 484       pragma Unreferenced (Prio);
 485    begin
 486       for N in Handlers'Range loop
 487          Attach_Handler (Handlers (N).Handler, Handlers (N).Interrupt, True);
 488       end loop;
 489    end Install_Restricted_Handlers;
 490
 491    ------------------------------
 492    -- Install_Umbrella_Handler --
 493    ------------------------------
 494
 495    procedure Install_Umbrella_Handler
 496      (Interrupt : HW_Interrupt;
 497       Handler   : System.OS_Interface.Interrupt_Handler)
 498    is
 499       Vec : constant Interrupt_Vector :=
 500               Interrupt_Number_To_Vector (int (Interrupt));
 501
 502       Status : int;
 503
 504    begin
 505       --  Only install umbrella handler when no Ada handler has already been
 506       --  installed. Note that the interrupt number is passed as a parameter
 507       --  when an interrupt occurs, so the umbrella handler has a different
 508       --  wrapper generated by intConnect for each interrupt number.
 509
 510       if not Handler_Installed (Interrupt) then
 511          Status :=
 512             Interrupt_Connect (Vec, Handler, System.Address (Interrupt));
 513          pragma Assert (Status = 0);
 514
 515          Handler_Installed (Interrupt) := True;
 516       end if;
 517    end Install_Umbrella_Handler;
 518
 519    ----------------
 520    -- Is_Blocked --
 521    ----------------
 522
 523    function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is
 524    begin
 525       Unimplemented ("Is_Blocked");
 526       return False;
 527    end Is_Blocked;
 528
 529    -----------------------
 530    -- Is_Entry_Attached --
 531    -----------------------
 532
 533    function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is
 534    begin
 535       Check_Reserved_Interrupt (Interrupt);
 536       return User_Entry (Interrupt).T /= Null_Task;
 537    end Is_Entry_Attached;
 538
 539    -------------------------
 540    -- Is_Handler_Attached --
 541    -------------------------
 542
 543    function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is
 544    begin
 545       Check_Reserved_Interrupt (Interrupt);
 546       return User_Handler (Interrupt).H /= null;
 547    end Is_Handler_Attached;
 548
 549    ----------------
 550    -- Is_Ignored --
 551    ----------------
 552
 553    function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is
 554    begin
 555       Unimplemented ("Is_Ignored");
 556       return False;
 557    end Is_Ignored;
 558
 559    -------------------
 560    -- Is_Registered --
 561    -------------------
 562
 563    function Is_Registered (Handler : Parameterless_Handler) return Boolean is
 564       type Fat_Ptr is record
 565          Object_Addr  : System.Address;
 566          Handler_Addr : System.Address;
 567       end record;
 568
 569       function To_Fat_Ptr is new Ada.Unchecked_Conversion
 570         (Parameterless_Handler, Fat_Ptr);
 571
 572       Ptr : R_Link;
 573       Fat : Fat_Ptr;
 574
 575    begin
 576       if Handler = null then
 577          return True;
 578       end if;
 579
 580       Fat := To_Fat_Ptr (Handler);
 581
 582       Ptr := Registered_Handler_Head;
 583       while Ptr /= null loop
 584          if Ptr.H = Fat.Handler_Addr then
 585             return True;
 586          end if;
 587
 588          Ptr := Ptr.Next;
 589       end loop;
 590
 591       return False;
 592    end Is_Registered;
 593
 594    -----------------
 595    -- Is_Reserved --
 596    -----------------
 597
 598    function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is
 599       use System.Interrupt_Management;
 600    begin
 601       return Reserve (System.Interrupt_Management.Interrupt_ID (Interrupt));
 602    end Is_Reserved;
 603
 604    ----------------------
 605    -- Notify_Interrupt --
 606    ----------------------
 607
 608    --  Umbrella handler for vectored hardware interrupts (as opposed to signals
 609    --  and exceptions). As opposed to the signal implementation, this handler
 610    --  is installed in the vector table when the first Ada handler is attached
 611    --  to the interrupt. However because VxWorks don't support disconnecting
 612    --  handlers, this subprogram always test whether or not an Ada handler is
 613    --  effectively attached.
 614
 615    --  Otherwise, the handler that existed prior to program startup is in the
 616    --  vector table. This ensures that handlers installed by the BSP are active
 617    --  unless explicitly replaced in the program text.
 618
 619    --  Each Interrupt_Server_Task has an associated binary semaphore on which
 620    --  it pends once it's been started. This routine determines The appropriate
 621    --  semaphore and issues a semGive call, waking the server task. When
 622    --  a handler is unbound, System.Interrupts.Unbind_Handler issues a
 623    --  Binary_Semaphore_Flush, and the server task deletes its semaphore
 624    --  and terminates.
 625
 626    procedure Notify_Interrupt (Param : System.Address) is
 627       Interrupt : constant Interrupt_ID := Interrupt_ID (Param);
 628       Id        : constant Binary_Semaphore_Id := Semaphore_ID_Map (Interrupt);
 629       Status    : int;
 630    begin
 631       if Id /= 0 then
 632          Status := Binary_Semaphore_Release (Id);
 633          pragma Assert (Status = 0);
 634       end if;
 635    end Notify_Interrupt;
 636
 637    ---------------
 638    -- Reference --
 639    ---------------
 640
 641    function Reference (Interrupt : Interrupt_ID) return System.Address is
 642    begin
 643       Check_Reserved_Interrupt (Interrupt);
 644       return Storage_Elements.To_Address
 645                (Storage_Elements.Integer_Address (Interrupt));
 646    end Reference;
 647
 648    --------------------------------
 649    -- Register_Interrupt_Handler --
 650    --------------------------------
 651
 652    procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is
 653       New_Node_Ptr : R_Link;
 654
 655    begin
 656       --  This routine registers a handler as usable for dynamic interrupt
 657       --  handler association. Routines attaching and detaching handlers
 658       --  dynamically should determine whether the handler is registered.
 659       --  Program_Error should be raised if it is not registered.
 660
 661       --  Pragma Interrupt_Handler can only appear in a library level PO
 662       --  definition and instantiation. Therefore, we do not need to implement
 663       --  an unregister operation. Nor do we need to protect the queue
 664       --  structure with a lock.
 665
 666       pragma Assert (Handler_Addr /= System.Null_Address);
 667
 668       New_Node_Ptr := new Registered_Handler;
 669       New_Node_Ptr.H := Handler_Addr;
 670
 671       if Registered_Handler_Head = null then
 672          Registered_Handler_Head := New_Node_Ptr;
 673          Registered_Handler_Tail := New_Node_Ptr;
 674       else
 675          Registered_Handler_Tail.Next := New_Node_Ptr;
 676          Registered_Handler_Tail := New_Node_Ptr;
 677       end if;
 678    end Register_Interrupt_Handler;
 679
 680    -----------------------
 681    -- Unblock_Interrupt --
 682    -----------------------
 683
 684    procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is
 685    begin
 686       Unimplemented ("Unblock_Interrupt");
 687    end Unblock_Interrupt;
 688
 689    ------------------
 690    -- Unblocked_By --
 691    ------------------
 692
 693    function Unblocked_By
 694      (Interrupt : Interrupt_ID) return System.Tasking.Task_Id
 695    is
 696    begin
 697       Unimplemented ("Unblocked_By");
 698       return Null_Task;
 699    end Unblocked_By;
 700
 701    ------------------------
 702    -- Unignore_Interrupt --
 703    ------------------------
 704
 705    procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is
 706    begin
 707       Unimplemented ("Unignore_Interrupt");
 708    end Unignore_Interrupt;
 709
 710    -------------------
 711    -- Unimplemented --
 712    -------------------
 713
 714    procedure Unimplemented (Feature : String) is
 715    begin
 716       raise Program_Error with Feature & " not implemented on VxWorks";
 717    end Unimplemented;
 718
 719    -----------------------
 720    -- Interrupt_Manager --
 721    -----------------------
 722
 723    task body Interrupt_Manager is
 724       --  By making this task independent of any master, when the process goes
 725       --  away, the Interrupt_Manager will terminate gracefully.
 726
 727       Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent;
 728       pragma Unreferenced (Ignore);
 729
 730       --------------------
 731       -- Local Routines --
 732       --------------------
 733
 734       procedure Bind_Handler (Interrupt : Interrupt_ID);
 735       --  This procedure does not do anything if a signal is blocked.
 736       --  Otherwise, we have to interrupt Server_Task for status change
 737       --  through a wakeup signal.
 738
 739       procedure Unbind_Handler (Interrupt : Interrupt_ID);
 740       --  This procedure does not do anything if a signal is blocked.
 741       --  Otherwise, we have to interrupt Server_Task for status change
 742       --  through an abort signal.
 743
 744       procedure Unprotected_Exchange_Handler
 745         (Old_Handler : out Parameterless_Handler;
 746          New_Handler : Parameterless_Handler;
 747          Interrupt   : Interrupt_ID;
 748          Static      : Boolean;
 749          Restoration : Boolean := False);
 750
 751       procedure Unprotected_Detach_Handler
 752         (Interrupt : Interrupt_ID;
 753          Static    : Boolean);
 754
 755       ------------------
 756       -- Bind_Handler --
 757       ------------------
 758
 759       procedure Bind_Handler (Interrupt : Interrupt_ID) is
 760       begin
 761          Install_Umbrella_Handler
 762            (HW_Interrupt (Interrupt), Notify_Interrupt'Access);
 763       end Bind_Handler;
 764
 765       --------------------
 766       -- Unbind_Handler --
 767       --------------------
 768
 769       procedure Unbind_Handler (Interrupt : Interrupt_ID) is
 770          Status : int;
 771
 772       begin
 773          --  Flush server task off semaphore, allowing it to terminate
 774
 775          Status := Binary_Semaphore_Flush (Semaphore_ID_Map (Interrupt));
 776          pragma Assert (Status = 0);
 777       end Unbind_Handler;
 778
 779       --------------------------------
 780       -- Unprotected_Detach_Handler --
 781       --------------------------------
 782
 783       procedure Unprotected_Detach_Handler
 784         (Interrupt : Interrupt_ID;
 785          Static    : Boolean)
 786       is
 787          Old_Handler : Parameterless_Handler;
 788       begin
 789          if User_Entry (Interrupt).T /= Null_Task then
 790
 791             --  If an interrupt entry is installed raise Program_Error
 792             --  (propagate it to the caller).
 793
 794             raise Program_Error with
 795               "an interrupt entry is already installed";
 796          end if;
 797
 798          --  Note : Static = True will pass the following check. This is the
 799          --  case when we want to detach a handler regardless of the static
 800          --  status of the Current_Handler.
 801
 802          if not Static and then User_Handler (Interrupt).Static then
 803
 804             --  Trying to detach a static Interrupt Handler, raise
 805             --  Program_Error.
 806
 807             raise Program_Error with
 808               "trying to detach a static Interrupt Handler";
 809          end if;
 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             --  If an interrupt entry is already installed, raise
 838             --  Program_Error (propagate it to the caller).
 839
 840             raise Program_Error with "an interrupt is already installed";
 841          end if;
 842
 843          --  Note : A null handler with Static = True will pass the following
 844          --  check. This is the case when we want to detach a handler
 845          --  regardless of the Static status of Current_Handler.
 846
 847          --  We don't check anything if Restoration is True, since we may be
 848          --  detaching a static handler to restore a dynamic one.
 849
 850          if not Restoration and then not Static
 851            and then (User_Handler (Interrupt).Static
 852
 853             --  Trying to overwrite a static Interrupt Handler with a dynamic
 854             --  Handler
 855
 856             --  The new handler is not specified as an Interrupt Handler by a
 857             --  pragma.
 858
 859            or else not Is_Registered (New_Handler))
 860          then
 861             raise Program_Error with
 862                "trying to overwrite a static interrupt handler with a "
 863                & "dynamic handler";
 864          end if;
 865
 866          --  Save the old handler
 867
 868          Old_Handler := User_Handler (Interrupt).H;
 869
 870          --  The new handler
 871
 872          User_Handler (Interrupt).H := New_Handler;
 873
 874          if New_Handler = null then
 875
 876             --  The null handler means we are detaching the handler
 877
 878             User_Handler (Interrupt).Static := False;
 879
 880          else
 881             User_Handler (Interrupt).Static := Static;
 882          end if;
 883
 884          --  Invoke a corresponding Server_Task if not yet created. Place
 885          --  Task_Id info in Server_ID array.
 886
 887          if New_Handler /= null
 888            and then
 889             (Server_ID (Interrupt) = Null_Task
 890               or else
 891                 Ada.Task_Identification.Is_Terminated
 892                   (To_Ada (Server_ID (Interrupt))))
 893          then
 894             Interrupt_Access_Hold :=
 895               new Interrupt_Server_Task (Interrupt, Binary_Semaphore_Create);
 896             Server_ID (Interrupt) :=
 897               To_System (Interrupt_Access_Hold.all'Identity);
 898          end if;
 899
 900          if (New_Handler = null) and then Old_Handler /= null then
 901
 902             --  Restore default handler
 903
 904             Unbind_Handler (Interrupt);
 905
 906          elsif Old_Handler = null then
 907
 908             --  Save default handler
 909
 910             Bind_Handler (Interrupt);
 911          end if;
 912       end Unprotected_Exchange_Handler;
 913
 914    --  Start of processing for Interrupt_Manager
 915
 916    begin
 917       loop
 918          --  A block is needed to absorb Program_Error exception
 919
 920          declare
 921             Old_Handler : Parameterless_Handler;
 922
 923          begin
 924             select
 925                accept Attach_Handler
 926                  (New_Handler : Parameterless_Handler;
 927                   Interrupt   : Interrupt_ID;
 928                   Static      : Boolean;
 929                   Restoration : Boolean := False)
 930                do
 931                   Unprotected_Exchange_Handler
 932                     (Old_Handler, New_Handler, Interrupt, Static, Restoration);
 933                end Attach_Handler;
 934
 935             or
 936                accept Exchange_Handler
 937                  (Old_Handler : out Parameterless_Handler;
 938                   New_Handler : Parameterless_Handler;
 939                   Interrupt   : Interrupt_ID;
 940                   Static      : Boolean)
 941                do
 942                   Unprotected_Exchange_Handler
 943                     (Old_Handler, New_Handler, Interrupt, Static);
 944                end Exchange_Handler;
 945
 946             or
 947                accept Detach_Handler
 948                   (Interrupt : Interrupt_ID;
 949                    Static    : Boolean)
 950                do
 951                   Unprotected_Detach_Handler (Interrupt, Static);
 952                end Detach_Handler;
 953
 954             or
 955                accept Bind_Interrupt_To_Entry
 956                  (T         : Task_Id;
 957                   E         : Task_Entry_Index;
 958                   Interrupt : Interrupt_ID)
 959                do
 960                   --  If there is a binding already (either a procedure or an
 961                   --  entry), raise Program_Error (propagate it to the caller).
 962
 963                   if User_Handler (Interrupt).H /= null
 964                     or else User_Entry (Interrupt).T /= Null_Task
 965                   then
 966                      raise Program_Error with
 967                        "a binding for this interrupt is already present";
 968                   end if;
 969
 970                   User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E);
 971
 972                   --  Indicate the attachment of interrupt entry in the ATCB.
 973                   --  This is needed so when an interrupt entry task terminates
 974                   --  the binding can be cleaned. The call to unbinding must be
 975                   --  make by the task before it terminates.
 976
 977                   T.Interrupt_Entry := True;
 978
 979                   --  Invoke a corresponding Server_Task if not yet created.
 980                   --  Place Task_Id info in Server_ID array.
 981
 982                   if Server_ID (Interrupt) = Null_Task
 983                     or else
 984                       Ada.Task_Identification.Is_Terminated
 985                         (To_Ada (Server_ID (Interrupt)))
 986                   then
 987                      Interrupt_Access_Hold := new Interrupt_Server_Task
 988                        (Interrupt, Binary_Semaphore_Create);
 989                      Server_ID (Interrupt) :=
 990                        To_System (Interrupt_Access_Hold.all'Identity);
 991                   end if;
 992
 993                   Bind_Handler (Interrupt);
 994                end Bind_Interrupt_To_Entry;
 995
 996             or
 997                accept Detach_Interrupt_Entries (T : Task_Id) do
 998                   for Int in Interrupt_ID'Range loop
 999                      if not Is_Reserved (Int) then
1000                         if User_Entry (Int).T = T then
1001                            User_Entry (Int) :=
1002                              Entry_Assoc'
1003                                (T => Null_Task, E => Null_Task_Entry);
1004                            Unbind_Handler (Int);
1005                         end if;
1006                      end if;
1007                   end loop;
1008
1009                   --  Indicate in ATCB that no interrupt entries are attached
1010
1011                   T.Interrupt_Entry := False;
1012                end Detach_Interrupt_Entries;
1013             end select;
1014
1015          exception
1016             --  If there is a Program_Error we just want to propagate it to
1017             --  the caller and do not want to stop this task.
1018
1019             when Program_Error =>
1020                null;
1021
1022             when others =>
1023                pragma Assert (False);
1024                null;
1025          end;
1026       end loop;
1027
1028    exception
1029       when Standard'Abort_Signal =>
1030
1031          --  Flush interrupt server semaphores, so they can terminate
1032
1033          Finalize_Interrupt_Servers;
1034          raise;
1035    end Interrupt_Manager;
1036
1037    ---------------------------
1038    -- Interrupt_Server_Task --
1039    ---------------------------
1040
1041    --  Server task for vectored hardware interrupt handling
1042
1043    task body Interrupt_Server_Task is
1044       Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent;
1045
1046       Self_Id         : constant Task_Id := Self;
1047       Tmp_Handler     : Parameterless_Handler;
1048       Tmp_ID          : Task_Id;
1049       Tmp_Entry_Index : Task_Entry_Index;
1050       Status          : int;
1051
1052    begin
1053       Semaphore_ID_Map (Interrupt) := Int_Sema;
1054
1055       loop
1056          --  Pend on semaphore that will be triggered by the umbrella handler
1057          --  when the associated interrupt comes in.
1058
1059          Status := Binary_Semaphore_Obtain (Int_Sema);
1060          pragma Assert (Status = 0);
1061
1062          if User_Handler (Interrupt).H /= null then
1063
1064             --  Protected procedure handler
1065
1066             Tmp_Handler := User_Handler (Interrupt).H;
1067             Tmp_Handler.all;
1068
1069          elsif User_Entry (Interrupt).T /= Null_Task then
1070
1071             --  Interrupt entry handler
1072
1073             Tmp_ID := User_Entry (Interrupt).T;
1074             Tmp_Entry_Index := User_Entry (Interrupt).E;
1075             System.Tasking.Rendezvous.Call_Simple
1076               (Tmp_ID, Tmp_Entry_Index, System.Null_Address);
1077
1078          else
1079             --  Semaphore has been flushed by an unbind operation in the
1080             --  Interrupt_Manager. Terminate the server task.
1081
1082             --  Wait for the Interrupt_Manager to complete its work
1083
1084             POP.Write_Lock (Self_Id);
1085
1086             --  Unassociate the interrupt handler
1087
1088             Semaphore_ID_Map (Interrupt) := 0;
1089
1090             --  Delete the associated semaphore
1091
1092             Status := Binary_Semaphore_Delete (Int_Sema);
1093
1094             pragma Assert (Status = 0);
1095
1096             --  Set status for the Interrupt_Manager
1097
1098             Server_ID (Interrupt) := Null_Task;
1099             POP.Unlock (Self_Id);
1100
1101             exit;
1102          end if;
1103       end loop;
1104    end Interrupt_Server_Task;
1105
1106 begin
1107    --  Get Interrupt_Manager's ID so that Abort_Interrupt can be sent
1108
1109    Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
1110 end System.Interrupts;