gcc/ada/s-interr-vxworks.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-2016, 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    type Interrupt_Connector is access function
 200      (Vector    : Interrupt_Vector;
 201       Handler   : Interrupt_Handler;
 202       Parameter : System.Address := System.Null_Address) return int;
 203    --  Profile must match VxWorks intConnect()
 204
 205    Interrupt_Connect : Interrupt_Connector :=
 206      System.OS_Interface.Interrupt_Connect'Access;
 207    pragma Export (C, Interrupt_Connect, "__gnat_user_int_connect");
 208    --  Allow user alternatives to the OS implementation of
 209    --  System.OS_Interface.Interrupt_Connect. This allows the user to
 210    --  associate a handler with an interrupt source when an alternate routine
 211    --  is needed to do so. The association is performed in
 212    --  Interfaces.VxWorks.Interrupt_Connections. Defaults to the standard OS
 213    --  connection routine.
 214
 215    -----------------------
 216    -- Local Subprograms --
 217    -----------------------
 218
 219    procedure Check_Reserved_Interrupt (Interrupt : Interrupt_ID);
 220    --  Check if Id is a reserved interrupt, and if so raise Program_Error
 221    --  with an appropriate message, otherwise return.
 222
 223    procedure Finalize_Interrupt_Servers;
 224    --  Unbind the handlers for hardware interrupt server tasks at program
 225    --  termination.
 226
 227    function Is_Registered (Handler : Parameterless_Handler) return Boolean;
 228    --  See if Handler has been "pragma"ed using Interrupt_Handler.
 229    --  Always consider a null handler as registered.
 230
 231    procedure Notify_Interrupt (Param : System.Address);
 232    pragma Convention (C, Notify_Interrupt);
 233    --  Umbrella handler for vectored interrupts (not signals)
 234
 235    procedure Install_Umbrella_Handler
 236      (Interrupt : HW_Interrupt;
 237       Handler   : System.OS_Interface.Interrupt_Handler);
 238    --  Install the runtime umbrella handler for a vectored hardware
 239    --  interrupt
 240
 241    procedure Unimplemented (Feature : String);
 242    pragma No_Return (Unimplemented);
 243    --  Used to mark a call to an unimplemented function. Raises Program_Error
 244    --  with an appropriate message noting that Feature is unimplemented.
 245
 246    --------------------
 247    -- Attach_Handler --
 248    --------------------
 249
 250    --  Calling this procedure with New_Handler = null and Static = True
 251    --  means we want to detach the current handler regardless of the previous
 252    --  handler's binding status (i.e. do not care if it is a dynamic or static
 253    --  handler).
 254
 255    --  This option is needed so that during the finalization of a PO, we can
 256    --  detach handlers attached through pragma Attach_Handler.
 257
 258    procedure Attach_Handler
 259      (New_Handler : Parameterless_Handler;
 260       Interrupt   : Interrupt_ID;
 261       Static      : Boolean := False) is
 262    begin
 263       Check_Reserved_Interrupt (Interrupt);
 264       Interrupt_Manager.Attach_Handler (New_Handler, Interrupt, Static);
 265    end Attach_Handler;
 266
 267    -----------------------------
 268    -- Bind_Interrupt_To_Entry --
 269    -----------------------------
 270
 271    --  This procedure raises a Program_Error if it tries to
 272    --  bind an interrupt to which an Entry or a Procedure is
 273    --  already bound.
 274
 275    procedure Bind_Interrupt_To_Entry
 276      (T       : Task_Id;
 277       E       : Task_Entry_Index;
 278       Int_Ref : System.Address)
 279    is
 280       Interrupt : constant Interrupt_ID :=
 281                     Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
 282    begin
 283       Check_Reserved_Interrupt (Interrupt);
 284       Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt);
 285    end Bind_Interrupt_To_Entry;
 286
 287    ---------------------
 288    -- Block_Interrupt --
 289    ---------------------
 290
 291    procedure Block_Interrupt (Interrupt : Interrupt_ID) is
 292    begin
 293       Unimplemented ("Block_Interrupt");
 294    end Block_Interrupt;
 295
 296    ------------------------------
 297    -- Check_Reserved_Interrupt --
 298    ------------------------------
 299
 300    procedure Check_Reserved_Interrupt (Interrupt : Interrupt_ID) is
 301    begin
 302       if Is_Reserved (Interrupt) then
 303          raise Program_Error with
 304            "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
 305       else
 306          return;
 307       end if;
 308    end Check_Reserved_Interrupt;
 309
 310    ---------------------
 311    -- Current_Handler --
 312    ---------------------
 313
 314    function Current_Handler
 315      (Interrupt : Interrupt_ID) return Parameterless_Handler
 316    is
 317    begin
 318       Check_Reserved_Interrupt (Interrupt);
 319
 320       --  ??? Since Parameterless_Handler is not Atomic, the current
 321       --  implementation is wrong. We need a new service in Interrupt_Manager
 322       --  to ensure atomicity.
 323
 324       return User_Handler (Interrupt).H;
 325    end Current_Handler;
 326
 327    --------------------
 328    -- Detach_Handler --
 329    --------------------
 330
 331    --  Calling this procedure with Static = True means we want to Detach the
 332    --  current handler regardless of the previous handler's binding status
 333    --  (i.e. do not care if it is a dynamic or static handler).
 334
 335    --  This option is needed so that during the finalization of a PO, we can
 336    --  detach handlers attached through pragma Attach_Handler.
 337
 338    procedure Detach_Handler
 339      (Interrupt : Interrupt_ID;
 340       Static    : Boolean := False)
 341    is
 342    begin
 343       Check_Reserved_Interrupt (Interrupt);
 344       Interrupt_Manager.Detach_Handler (Interrupt, Static);
 345    end Detach_Handler;
 346
 347    ------------------------------
 348    -- Detach_Interrupt_Entries --
 349    ------------------------------
 350
 351    procedure Detach_Interrupt_Entries (T : Task_Id) is
 352    begin
 353       Interrupt_Manager.Detach_Interrupt_Entries (T);
 354    end Detach_Interrupt_Entries;
 355
 356    ----------------------
 357    -- Exchange_Handler --
 358    ----------------------
 359
 360    --  Calling this procedure with New_Handler = null and Static = True
 361    --  means we want to detach the current handler regardless of the previous
 362    --  handler's binding status (i.e. we do not care if it is a dynamic or
 363    --  static handler).
 364
 365    --  This option is needed so that during the finalization of a PO, we can
 366    --  detach handlers attached through pragma Attach_Handler.
 367
 368    procedure Exchange_Handler
 369      (Old_Handler : out Parameterless_Handler;
 370       New_Handler : Parameterless_Handler;
 371       Interrupt   : Interrupt_ID;
 372       Static      : Boolean := False)
 373    is
 374    begin
 375       Check_Reserved_Interrupt (Interrupt);
 376       Interrupt_Manager.Exchange_Handler
 377         (Old_Handler, New_Handler, Interrupt, Static);
 378    end Exchange_Handler;
 379
 380    --------------
 381    -- Finalize --
 382    --------------
 383
 384    procedure Finalize (Object : in out Static_Interrupt_Protection) is
 385    begin
 386       --  ??? loop to be executed only when we're not doing library level
 387       --  finalization, since in this case all interrupt / signal tasks are
 388       --  gone.
 389
 390       if not Interrupt_Manager'Terminated then
 391          for N in reverse Object.Previous_Handlers'Range loop
 392             Interrupt_Manager.Attach_Handler
 393               (New_Handler => Object.Previous_Handlers (N).Handler,
 394                Interrupt   => Object.Previous_Handlers (N).Interrupt,
 395                Static      => Object.Previous_Handlers (N).Static,
 396                Restoration => True);
 397          end loop;
 398       end if;
 399
 400       Tasking.Protected_Objects.Entries.Finalize
 401         (Tasking.Protected_Objects.Entries.Protection_Entries (Object));
 402    end Finalize;
 403
 404    --------------------------------
 405    -- Finalize_Interrupt_Servers --
 406    --------------------------------
 407
 408    --  Restore default handlers for interrupt servers
 409
 410    --  This is called by the Interrupt_Manager task when it receives the abort
 411    --  signal during program finalization.
 412
 413    procedure Finalize_Interrupt_Servers is
 414       HW_Interrupts : constant Boolean := HW_Interrupt'Last >= 0;
 415    begin
 416       if HW_Interrupts then
 417          for Int in HW_Interrupt loop
 418             if Server_ID (Interrupt_ID (Int)) /= null
 419               and then
 420                 not Ada.Task_Identification.Is_Terminated
 421                  (To_Ada (Server_ID (Interrupt_ID (Int))))
 422             then
 423                Interrupt_Manager.Attach_Handler
 424                  (New_Handler => null,
 425                   Interrupt   => Interrupt_ID (Int),
 426                   Static      => True,
 427                   Restoration => True);
 428             end if;
 429          end loop;
 430       end if;
 431    end Finalize_Interrupt_Servers;
 432
 433    -------------------------------------
 434    -- Has_Interrupt_Or_Attach_Handler --
 435    -------------------------------------
 436
 437    function Has_Interrupt_Or_Attach_Handler
 438      (Object : access Dynamic_Interrupt_Protection)
 439       return   Boolean
 440    is
 441       pragma Unreferenced (Object);
 442    begin
 443       return True;
 444    end Has_Interrupt_Or_Attach_Handler;
 445
 446    function Has_Interrupt_Or_Attach_Handler
 447      (Object : access Static_Interrupt_Protection)
 448       return   Boolean
 449    is
 450       pragma Unreferenced (Object);
 451    begin
 452       return True;
 453    end Has_Interrupt_Or_Attach_Handler;
 454
 455    ----------------------
 456    -- Ignore_Interrupt --
 457    ----------------------
 458
 459    procedure Ignore_Interrupt (Interrupt : Interrupt_ID) is
 460    begin
 461       Unimplemented ("Ignore_Interrupt");
 462    end Ignore_Interrupt;
 463
 464    ----------------------
 465    -- Install_Handlers --
 466    ----------------------
 467
 468    procedure Install_Handlers
 469      (Object       : access Static_Interrupt_Protection;
 470       New_Handlers : New_Handler_Array)
 471    is
 472    begin
 473       for N in New_Handlers'Range loop
 474
 475          --  We need a lock around this ???
 476
 477          Object.Previous_Handlers (N).Interrupt := New_Handlers (N).Interrupt;
 478          Object.Previous_Handlers (N).Static    := User_Handler
 479            (New_Handlers (N).Interrupt).Static;
 480
 481          --  We call Exchange_Handler and not directly Interrupt_Manager.
 482          --  Exchange_Handler so we get the Is_Reserved check.
 483
 484          Exchange_Handler
 485            (Old_Handler => Object.Previous_Handlers (N).Handler,
 486             New_Handler => New_Handlers (N).Handler,
 487             Interrupt   => New_Handlers (N).Interrupt,
 488             Static      => True);
 489       end loop;
 490    end Install_Handlers;
 491
 492    ---------------------------------
 493    -- Install_Restricted_Handlers --
 494    ---------------------------------
 495
 496    procedure Install_Restricted_Handlers
 497       (Prio     : Any_Priority;
 498        Handlers : New_Handler_Array)
 499    is
 500       pragma Unreferenced (Prio);
 501    begin
 502       for N in Handlers'Range loop
 503          Attach_Handler (Handlers (N).Handler, Handlers (N).Interrupt, True);
 504       end loop;
 505    end Install_Restricted_Handlers;
 506
 507    ------------------------------
 508    -- Install_Umbrella_Handler --
 509    ------------------------------
 510
 511    procedure Install_Umbrella_Handler
 512      (Interrupt : HW_Interrupt;
 513       Handler   : System.OS_Interface.Interrupt_Handler)
 514    is
 515       Vec : constant Interrupt_Vector :=
 516               Interrupt_Number_To_Vector (int (Interrupt));
 517
 518       Status : int;
 519
 520    begin
 521       --  Only install umbrella handler when no Ada handler has already been
 522       --  installed. Note that the interrupt number is passed as a parameter
 523       --  when an interrupt occurs, so the umbrella handler has a different
 524       --  wrapper generated by the connector routine for each interrupt
 525       --  number.
 526
 527       if not Handler_Installed (Interrupt) then
 528          Status :=
 529            Interrupt_Connect.all (Vec, Handler, System.Address (Interrupt));
 530          pragma Assert (Status = 0);
 531
 532          Handler_Installed (Interrupt) := True;
 533       end if;
 534    end Install_Umbrella_Handler;
 535
 536    ----------------
 537    -- Is_Blocked --
 538    ----------------
 539
 540    function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is
 541    begin
 542       Unimplemented ("Is_Blocked");
 543       return False;
 544    end Is_Blocked;
 545
 546    -----------------------
 547    -- Is_Entry_Attached --
 548    -----------------------
 549
 550    function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is
 551    begin
 552       Check_Reserved_Interrupt (Interrupt);
 553       return User_Entry (Interrupt).T /= Null_Task;
 554    end Is_Entry_Attached;
 555
 556    -------------------------
 557    -- Is_Handler_Attached --
 558    -------------------------
 559
 560    function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is
 561    begin
 562       Check_Reserved_Interrupt (Interrupt);
 563       return User_Handler (Interrupt).H /= null;
 564    end Is_Handler_Attached;
 565
 566    ----------------
 567    -- Is_Ignored --
 568    ----------------
 569
 570    function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is
 571    begin
 572       Unimplemented ("Is_Ignored");
 573       return False;
 574    end Is_Ignored;
 575
 576    -------------------
 577    -- Is_Registered --
 578    -------------------
 579
 580    function Is_Registered (Handler : Parameterless_Handler) return Boolean is
 581       type Fat_Ptr is record
 582          Object_Addr  : System.Address;
 583          Handler_Addr : System.Address;
 584       end record;
 585
 586       function To_Fat_Ptr is new Ada.Unchecked_Conversion
 587         (Parameterless_Handler, Fat_Ptr);
 588
 589       Ptr : R_Link;
 590       Fat : Fat_Ptr;
 591
 592    begin
 593       if Handler = null then
 594          return True;
 595       end if;
 596
 597       Fat := To_Fat_Ptr (Handler);
 598
 599       Ptr := Registered_Handler_Head;
 600       while Ptr /= null loop
 601          if Ptr.H = Fat.Handler_Addr then
 602             return True;
 603          end if;
 604
 605          Ptr := Ptr.Next;
 606       end loop;
 607
 608       return False;
 609    end Is_Registered;
 610
 611    -----------------
 612    -- Is_Reserved --
 613    -----------------
 614
 615    function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is
 616       use System.Interrupt_Management;
 617    begin
 618       return Reserve (System.Interrupt_Management.Interrupt_ID (Interrupt));
 619    end Is_Reserved;
 620
 621    ----------------------
 622    -- Notify_Interrupt --
 623    ----------------------
 624
 625    --  Umbrella handler for vectored hardware interrupts (as opposed to signals
 626    --  and exceptions). As opposed to the signal implementation, this handler
 627    --  is installed in the vector table when the first Ada handler is attached
 628    --  to the interrupt. However because VxWorks don't support disconnecting
 629    --  handlers, this subprogram always test whether or not an Ada handler is
 630    --  effectively attached.
 631
 632    --  Otherwise, the handler that existed prior to program startup is in the
 633    --  vector table. This ensures that handlers installed by the BSP are active
 634    --  unless explicitly replaced in the program text.
 635
 636    --  Each Interrupt_Server_Task has an associated binary semaphore on which
 637    --  it pends once it's been started. This routine determines The appropriate
 638    --  semaphore and issues a semGive call, waking the server task. When
 639    --  a handler is unbound, System.Interrupts.Unbind_Handler issues a
 640    --  Binary_Semaphore_Flush, and the server task deletes its semaphore
 641    --  and terminates.
 642
 643    procedure Notify_Interrupt (Param : System.Address) is
 644       Interrupt : constant Interrupt_ID := Interrupt_ID (Param);
 645       Id        : constant Binary_Semaphore_Id := Semaphore_ID_Map (Interrupt);
 646       Status    : int;
 647    begin
 648       if Id /= 0 then
 649          Status := Binary_Semaphore_Release (Id);
 650          pragma Assert (Status = 0);
 651       end if;
 652    end Notify_Interrupt;
 653
 654    ---------------
 655    -- Reference --
 656    ---------------
 657
 658    function Reference (Interrupt : Interrupt_ID) return System.Address is
 659    begin
 660       Check_Reserved_Interrupt (Interrupt);
 661       return Storage_Elements.To_Address
 662                (Storage_Elements.Integer_Address (Interrupt));
 663    end Reference;
 664
 665    --------------------------------
 666    -- Register_Interrupt_Handler --
 667    --------------------------------
 668
 669    procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is
 670       New_Node_Ptr : R_Link;
 671
 672    begin
 673       --  This routine registers a handler as usable for dynamic interrupt
 674       --  handler association. Routines attaching and detaching handlers
 675       --  dynamically should determine whether the handler is registered.
 676       --  Program_Error should be raised if it is not registered.
 677
 678       --  Pragma Interrupt_Handler can only appear in a library level PO
 679       --  definition and instantiation. Therefore, we do not need to implement
 680       --  an unregister operation. Nor do we need to protect the queue
 681       --  structure with a lock.
 682
 683       pragma Assert (Handler_Addr /= System.Null_Address);
 684
 685       New_Node_Ptr := new Registered_Handler;
 686       New_Node_Ptr.H := Handler_Addr;
 687
 688       if Registered_Handler_Head = null then
 689          Registered_Handler_Head := New_Node_Ptr;
 690          Registered_Handler_Tail := New_Node_Ptr;
 691       else
 692          Registered_Handler_Tail.Next := New_Node_Ptr;
 693          Registered_Handler_Tail := New_Node_Ptr;
 694       end if;
 695    end Register_Interrupt_Handler;
 696
 697    -----------------------
 698    -- Unblock_Interrupt --
 699    -----------------------
 700
 701    procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is
 702    begin
 703       Unimplemented ("Unblock_Interrupt");
 704    end Unblock_Interrupt;
 705
 706    ------------------
 707    -- Unblocked_By --
 708    ------------------
 709
 710    function Unblocked_By
 711      (Interrupt : Interrupt_ID) return System.Tasking.Task_Id
 712    is
 713    begin
 714       Unimplemented ("Unblocked_By");
 715       return Null_Task;
 716    end Unblocked_By;
 717
 718    ------------------------
 719    -- Unignore_Interrupt --
 720    ------------------------
 721
 722    procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is
 723    begin
 724       Unimplemented ("Unignore_Interrupt");
 725    end Unignore_Interrupt;
 726
 727    -------------------
 728    -- Unimplemented --
 729    -------------------
 730
 731    procedure Unimplemented (Feature : String) is
 732    begin
 733       raise Program_Error with Feature & " not implemented on VxWorks";
 734    end Unimplemented;
 735
 736    -----------------------
 737    -- Interrupt_Manager --
 738    -----------------------
 739
 740    task body Interrupt_Manager is
 741       --  By making this task independent of any master, when the process goes
 742       --  away, the Interrupt_Manager will terminate gracefully.
 743
 744       Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent;
 745       pragma Unreferenced (Ignore);
 746
 747       --------------------
 748       -- Local Routines --
 749       --------------------
 750
 751       procedure Bind_Handler (Interrupt : Interrupt_ID);
 752       --  This procedure does not do anything if a signal is blocked.
 753       --  Otherwise, we have to interrupt Server_Task for status change
 754       --  through a wakeup signal.
 755
 756       procedure Unbind_Handler (Interrupt : Interrupt_ID);
 757       --  This procedure does not do anything if a signal is blocked.
 758       --  Otherwise, we have to interrupt Server_Task for status change
 759       --  through an abort signal.
 760
 761       procedure Unprotected_Exchange_Handler
 762         (Old_Handler : out Parameterless_Handler;
 763          New_Handler : Parameterless_Handler;
 764          Interrupt   : Interrupt_ID;
 765          Static      : Boolean;
 766          Restoration : Boolean := False);
 767
 768       procedure Unprotected_Detach_Handler
 769         (Interrupt : Interrupt_ID;
 770          Static    : Boolean);
 771
 772       ------------------
 773       -- Bind_Handler --
 774       ------------------
 775
 776       procedure Bind_Handler (Interrupt : Interrupt_ID) is
 777       begin
 778          Install_Umbrella_Handler
 779            (HW_Interrupt (Interrupt), Notify_Interrupt'Access);
 780       end Bind_Handler;
 781
 782       --------------------
 783       -- Unbind_Handler --
 784       --------------------
 785
 786       procedure Unbind_Handler (Interrupt : Interrupt_ID) is
 787          Status : int;
 788
 789       begin
 790          --  Flush server task off semaphore, allowing it to terminate
 791
 792          Status := Binary_Semaphore_Flush (Semaphore_ID_Map (Interrupt));
 793          pragma Assert (Status = 0);
 794       end Unbind_Handler;
 795
 796       --------------------------------
 797       -- Unprotected_Detach_Handler --
 798       --------------------------------
 799
 800       procedure Unprotected_Detach_Handler
 801         (Interrupt : Interrupt_ID;
 802          Static    : Boolean)
 803       is
 804          Old_Handler : Parameterless_Handler;
 805       begin
 806          if User_Entry (Interrupt).T /= Null_Task then
 807
 808             --  If an interrupt entry is installed raise Program_Error
 809             --  (propagate it to the caller).
 810
 811             raise Program_Error with
 812               "an interrupt entry is already installed";
 813          end if;
 814
 815          --  Note : Static = True will pass the following check. This is the
 816          --  case when we want to detach a handler regardless of the static
 817          --  status of the Current_Handler.
 818
 819          if not Static and then User_Handler (Interrupt).Static then
 820
 821             --  Trying to detach a static Interrupt Handler, raise
 822             --  Program_Error.
 823
 824             raise Program_Error with
 825               "trying to detach a static Interrupt Handler";
 826          end if;
 827
 828          Old_Handler := User_Handler (Interrupt).H;
 829
 830          --  The new handler
 831
 832          User_Handler (Interrupt).H := null;
 833          User_Handler (Interrupt).Static := False;
 834
 835          if Old_Handler /= null then
 836             Unbind_Handler (Interrupt);
 837          end if;
 838       end Unprotected_Detach_Handler;
 839
 840       ----------------------------------
 841       -- Unprotected_Exchange_Handler --
 842       ----------------------------------
 843
 844       procedure Unprotected_Exchange_Handler
 845         (Old_Handler : out Parameterless_Handler;
 846          New_Handler : Parameterless_Handler;
 847          Interrupt   : Interrupt_ID;
 848          Static      : Boolean;
 849          Restoration : Boolean := False)
 850       is
 851       begin
 852          if User_Entry (Interrupt).T /= Null_Task then
 853
 854             --  If an interrupt entry is already installed, raise
 855             --  Program_Error (propagate it to the caller).
 856
 857             raise Program_Error with "an interrupt is already installed";
 858          end if;
 859
 860          --  Note : A null handler with Static = True will pass the following
 861          --  check. This is the case when we want to detach a handler
 862          --  regardless of the Static status of Current_Handler.
 863
 864          --  We don't check anything if Restoration is True, since we may be
 865          --  detaching a static handler to restore a dynamic one.
 866
 867          if not Restoration and then not Static
 868            and then (User_Handler (Interrupt).Static
 869
 870             --  Trying to overwrite a static Interrupt Handler with a dynamic
 871             --  Handler
 872
 873             --  The new handler is not specified as an Interrupt Handler by a
 874             --  pragma.
 875
 876            or else not Is_Registered (New_Handler))
 877          then
 878             raise Program_Error with
 879                "trying to overwrite a static interrupt handler with a "
 880                & "dynamic handler";
 881          end if;
 882
 883          --  Save the old handler
 884
 885          Old_Handler := User_Handler (Interrupt).H;
 886
 887          --  The new handler
 888
 889          User_Handler (Interrupt).H := New_Handler;
 890
 891          if New_Handler = null then
 892
 893             --  The null handler means we are detaching the handler
 894
 895             User_Handler (Interrupt).Static := False;
 896
 897          else
 898             User_Handler (Interrupt).Static := Static;
 899          end if;
 900
 901          --  Invoke a corresponding Server_Task if not yet created. Place
 902          --  Task_Id info in Server_ID array.
 903
 904          if New_Handler /= null
 905            and then
 906             (Server_ID (Interrupt) = Null_Task
 907               or else
 908                 Ada.Task_Identification.Is_Terminated
 909                   (To_Ada (Server_ID (Interrupt))))
 910          then
 911             Interrupt_Access_Hold :=
 912               new Interrupt_Server_Task (Interrupt, Binary_Semaphore_Create);
 913             Server_ID (Interrupt) :=
 914               To_System (Interrupt_Access_Hold.all'Identity);
 915          end if;
 916
 917          if (New_Handler = null) and then Old_Handler /= null then
 918
 919             --  Restore default handler
 920
 921             Unbind_Handler (Interrupt);
 922
 923          elsif Old_Handler = null then
 924
 925             --  Save default handler
 926
 927             Bind_Handler (Interrupt);
 928          end if;
 929       end Unprotected_Exchange_Handler;
 930
 931    --  Start of processing for Interrupt_Manager
 932
 933    begin
 934       loop
 935          --  A block is needed to absorb Program_Error exception
 936
 937          declare
 938             Old_Handler : Parameterless_Handler;
 939
 940          begin
 941             select
 942                accept Attach_Handler
 943                  (New_Handler : Parameterless_Handler;
 944                   Interrupt   : Interrupt_ID;
 945                   Static      : Boolean;
 946                   Restoration : Boolean := False)
 947                do
 948                   Unprotected_Exchange_Handler
 949                     (Old_Handler, New_Handler, Interrupt, Static, Restoration);
 950                end Attach_Handler;
 951
 952             or
 953                accept Exchange_Handler
 954                  (Old_Handler : out Parameterless_Handler;
 955                   New_Handler : Parameterless_Handler;
 956                   Interrupt   : Interrupt_ID;
 957                   Static      : Boolean)
 958                do
 959                   Unprotected_Exchange_Handler
 960                     (Old_Handler, New_Handler, Interrupt, Static);
 961                end Exchange_Handler;
 962
 963             or
 964                accept Detach_Handler
 965                   (Interrupt : Interrupt_ID;
 966                    Static    : Boolean)
 967                do
 968                   Unprotected_Detach_Handler (Interrupt, Static);
 969                end Detach_Handler;
 970
 971             or
 972                accept Bind_Interrupt_To_Entry
 973                  (T         : Task_Id;
 974                   E         : Task_Entry_Index;
 975                   Interrupt : Interrupt_ID)
 976                do
 977                   --  If there is a binding already (either a procedure or an
 978                   --  entry), raise Program_Error (propagate it to the caller).
 979
 980                   if User_Handler (Interrupt).H /= null
 981                     or else User_Entry (Interrupt).T /= Null_Task
 982                   then
 983                      raise Program_Error with
 984                        "a binding for this interrupt is already present";
 985                   end if;
 986
 987                   User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E);
 988
 989                   --  Indicate the attachment of interrupt entry in the ATCB.
 990                   --  This is needed so when an interrupt entry task terminates
 991                   --  the binding can be cleaned. The call to unbinding must be
 992                   --  make by the task before it terminates.
 993
 994                   T.Interrupt_Entry := True;
 995
 996                   --  Invoke a corresponding Server_Task if not yet created.
 997                   --  Place Task_Id info in Server_ID array.
 998
 999                   if Server_ID (Interrupt) = Null_Task
1000                     or else
1001                       Ada.Task_Identification.Is_Terminated
1002                         (To_Ada (Server_ID (Interrupt)))
1003                   then
1004                      Interrupt_Access_Hold := new Interrupt_Server_Task
1005                        (Interrupt, Binary_Semaphore_Create);
1006                      Server_ID (Interrupt) :=
1007                        To_System (Interrupt_Access_Hold.all'Identity);
1008                   end if;
1009
1010                   Bind_Handler (Interrupt);
1011                end Bind_Interrupt_To_Entry;
1012
1013             or
1014                accept Detach_Interrupt_Entries (T : Task_Id) do
1015                   for Int in Interrupt_ID'Range loop
1016                      if not Is_Reserved (Int) then
1017                         if User_Entry (Int).T = T then
1018                            User_Entry (Int) :=
1019                              Entry_Assoc'
1020                                (T => Null_Task, E => Null_Task_Entry);
1021                            Unbind_Handler (Int);
1022                         end if;
1023                      end if;
1024                   end loop;
1025
1026                   --  Indicate in ATCB that no interrupt entries are attached
1027
1028                   T.Interrupt_Entry := False;
1029                end Detach_Interrupt_Entries;
1030             end select;
1031
1032          exception
1033             --  If there is a Program_Error we just want to propagate it to
1034             --  the caller and do not want to stop this task.
1035
1036             when Program_Error =>
1037                null;
1038
1039             when others =>
1040                pragma Assert (False);
1041                null;
1042          end;
1043       end loop;
1044
1045    exception
1046       when Standard'Abort_Signal =>
1047
1048          --  Flush interrupt server semaphores, so they can terminate
1049
1050          Finalize_Interrupt_Servers;
1051          raise;
1052    end Interrupt_Manager;
1053
1054    ---------------------------
1055    -- Interrupt_Server_Task --
1056    ---------------------------
1057
1058    --  Server task for vectored hardware interrupt handling
1059
1060    task body Interrupt_Server_Task is
1061       Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent;
1062
1063       Self_Id         : constant Task_Id := Self;
1064       Tmp_Handler     : Parameterless_Handler;
1065       Tmp_ID          : Task_Id;
1066       Tmp_Entry_Index : Task_Entry_Index;
1067       Status          : int;
1068
1069    begin
1070       Semaphore_ID_Map (Interrupt) := Int_Sema;
1071
1072       loop
1073          --  Pend on semaphore that will be triggered by the umbrella handler
1074          --  when the associated interrupt comes in.
1075
1076          Status := Binary_Semaphore_Obtain (Int_Sema);
1077          pragma Assert (Status = 0);
1078
1079          if User_Handler (Interrupt).H /= null then
1080
1081             --  Protected procedure handler
1082
1083             Tmp_Handler := User_Handler (Interrupt).H;
1084             Tmp_Handler.all;
1085
1086          elsif User_Entry (Interrupt).T /= Null_Task then
1087
1088             --  Interrupt entry handler
1089
1090             Tmp_ID := User_Entry (Interrupt).T;
1091             Tmp_Entry_Index := User_Entry (Interrupt).E;
1092             System.Tasking.Rendezvous.Call_Simple
1093               (Tmp_ID, Tmp_Entry_Index, System.Null_Address);
1094
1095          else
1096             --  Semaphore has been flushed by an unbind operation in the
1097             --  Interrupt_Manager. Terminate the server task.
1098
1099             --  Wait for the Interrupt_Manager to complete its work
1100
1101             POP.Write_Lock (Self_Id);
1102
1103             --  Unassociate the interrupt handler
1104
1105             Semaphore_ID_Map (Interrupt) := 0;
1106
1107             --  Delete the associated semaphore
1108
1109             Status := Binary_Semaphore_Delete (Int_Sema);
1110
1111             pragma Assert (Status = 0);
1112
1113             --  Set status for the Interrupt_Manager
1114
1115             Server_ID (Interrupt) := Null_Task;
1116             POP.Unlock (Self_Id);
1117
1118             exit;
1119          end if;
1120       end loop;
1121    end Interrupt_Server_Task;
1122
1123 begin
1124    --  Get Interrupt_Manager's ID so that Abort_Interrupt can be sent
1125
1126    Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
1127 end System.Interrupts;