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