gcc/ada/s-interr-vxworks.adb

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