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