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