gcc/ada/s-interr-vxworks.adb

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