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