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