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-2014, 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 type Fat_Ptr is record 565 Object_Addr : System.Address; 566 Handler_Addr : System.Address; 567 end record; 568 569 function To_Fat_Ptr is new Ada.Unchecked_Conversion 570 (Parameterless_Handler, Fat_Ptr); 571 572 Ptr : R_Link; 573 Fat : Fat_Ptr; 574 575 begin 576 if Handler = null then 577 return True; 578 end if; 579 580 Fat := To_Fat_Ptr (Handler); 581 582 Ptr := Registered_Handler_Head; 583 while Ptr /= null loop 584 if Ptr.H = Fat.Handler_Addr then 585 return True; 586 end if; 587 588 Ptr := Ptr.Next; 589 end loop; 590 591 return False; 592 end Is_Registered; 593 594 ----------------- 595 -- Is_Reserved -- 596 ----------------- 597 598 function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is 599 use System.Interrupt_Management; 600 begin 601 return Reserve (System.Interrupt_Management.Interrupt_ID (Interrupt)); 602 end Is_Reserved; 603 604 ---------------------- 605 -- Notify_Interrupt -- 606 ---------------------- 607 608 -- Umbrella handler for vectored hardware interrupts (as opposed to signals 609 -- and exceptions). As opposed to the signal implementation, this handler 610 -- is installed in the vector table when the first Ada handler is attached 611 -- to the interrupt. However because VxWorks don't support disconnecting 612 -- handlers, this subprogram always test whether or not an Ada handler is 613 -- effectively attached. 614 615 -- Otherwise, the handler that existed prior to program startup is in the 616 -- vector table. This ensures that handlers installed by the BSP are active 617 -- unless explicitly replaced in the program text. 618 619 -- Each Interrupt_Server_Task has an associated binary semaphore on which 620 -- it pends once it's been started. This routine determines The appropriate 621 -- semaphore and issues a semGive call, waking the server task. When 622 -- a handler is unbound, System.Interrupts.Unbind_Handler issues a 623 -- Binary_Semaphore_Flush, and the server task deletes its semaphore 624 -- and terminates. 625 626 procedure Notify_Interrupt (Param : System.Address) is 627 Interrupt : constant Interrupt_ID := Interrupt_ID (Param); 628 Id : constant Binary_Semaphore_Id := Semaphore_ID_Map (Interrupt); 629 Status : int; 630 begin 631 if Id /= 0 then 632 Status := Binary_Semaphore_Release (Id); 633 pragma Assert (Status = 0); 634 end if; 635 end Notify_Interrupt; 636 637 --------------- 638 -- Reference -- 639 --------------- 640 641 function Reference (Interrupt : Interrupt_ID) return System.Address is 642 begin 643 Check_Reserved_Interrupt (Interrupt); 644 return Storage_Elements.To_Address 645 (Storage_Elements.Integer_Address (Interrupt)); 646 end Reference; 647 648 -------------------------------- 649 -- Register_Interrupt_Handler -- 650 -------------------------------- 651 652 procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is 653 New_Node_Ptr : R_Link; 654 655 begin 656 -- This routine registers a handler as usable for dynamic interrupt 657 -- handler association. Routines attaching and detaching handlers 658 -- dynamically should determine whether the handler is registered. 659 -- Program_Error should be raised if it is not registered. 660 661 -- Pragma Interrupt_Handler can only appear in a library level PO 662 -- definition and instantiation. Therefore, we do not need to implement 663 -- an unregister operation. Nor do we need to protect the queue 664 -- structure with a lock. 665 666 pragma Assert (Handler_Addr /= System.Null_Address); 667 668 New_Node_Ptr := new Registered_Handler; 669 New_Node_Ptr.H := Handler_Addr; 670 671 if Registered_Handler_Head = null then 672 Registered_Handler_Head := New_Node_Ptr; 673 Registered_Handler_Tail := New_Node_Ptr; 674 else 675 Registered_Handler_Tail.Next := New_Node_Ptr; 676 Registered_Handler_Tail := New_Node_Ptr; 677 end if; 678 end Register_Interrupt_Handler; 679 680 ----------------------- 681 -- Unblock_Interrupt -- 682 ----------------------- 683 684 procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is 685 begin 686 Unimplemented ("Unblock_Interrupt"); 687 end Unblock_Interrupt; 688 689 ------------------ 690 -- Unblocked_By -- 691 ------------------ 692 693 function Unblocked_By 694 (Interrupt : Interrupt_ID) return System.Tasking.Task_Id 695 is 696 begin 697 Unimplemented ("Unblocked_By"); 698 return Null_Task; 699 end Unblocked_By; 700 701 ------------------------ 702 -- Unignore_Interrupt -- 703 ------------------------ 704 705 procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is 706 begin 707 Unimplemented ("Unignore_Interrupt"); 708 end Unignore_Interrupt; 709 710 ------------------- 711 -- Unimplemented -- 712 ------------------- 713 714 procedure Unimplemented (Feature : String) is 715 begin 716 raise Program_Error with Feature & " not implemented on VxWorks"; 717 end Unimplemented; 718 719 ----------------------- 720 -- Interrupt_Manager -- 721 ----------------------- 722 723 task body Interrupt_Manager is 724 -- By making this task independent of any master, when the process goes 725 -- away, the Interrupt_Manager will terminate gracefully. 726 727 Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent; 728 pragma Unreferenced (Ignore); 729 730 -------------------- 731 -- Local Routines -- 732 -------------------- 733 734 procedure Bind_Handler (Interrupt : Interrupt_ID); 735 -- This procedure does not do anything if a signal is blocked. 736 -- Otherwise, we have to interrupt Server_Task for status change 737 -- through a wakeup signal. 738 739 procedure Unbind_Handler (Interrupt : Interrupt_ID); 740 -- This procedure does not do anything if a signal is blocked. 741 -- Otherwise, we have to interrupt Server_Task for status change 742 -- through an abort signal. 743 744 procedure Unprotected_Exchange_Handler 745 (Old_Handler : out Parameterless_Handler; 746 New_Handler : Parameterless_Handler; 747 Interrupt : Interrupt_ID; 748 Static : Boolean; 749 Restoration : Boolean := False); 750 751 procedure Unprotected_Detach_Handler 752 (Interrupt : Interrupt_ID; 753 Static : Boolean); 754 755 ------------------ 756 -- Bind_Handler -- 757 ------------------ 758 759 procedure Bind_Handler (Interrupt : Interrupt_ID) is 760 begin 761 Install_Umbrella_Handler 762 (HW_Interrupt (Interrupt), Notify_Interrupt'Access); 763 end Bind_Handler; 764 765 -------------------- 766 -- Unbind_Handler -- 767 -------------------- 768 769 procedure Unbind_Handler (Interrupt : Interrupt_ID) is 770 Status : int; 771 772 begin 773 -- Flush server task off semaphore, allowing it to terminate 774 775 Status := Binary_Semaphore_Flush (Semaphore_ID_Map (Interrupt)); 776 pragma Assert (Status = 0); 777 end Unbind_Handler; 778 779 -------------------------------- 780 -- Unprotected_Detach_Handler -- 781 -------------------------------- 782 783 procedure Unprotected_Detach_Handler 784 (Interrupt : Interrupt_ID; 785 Static : Boolean) 786 is 787 Old_Handler : Parameterless_Handler; 788 begin 789 if User_Entry (Interrupt).T /= Null_Task then 790 791 -- If an interrupt entry is installed raise Program_Error 792 -- (propagate it to the caller). 793 794 raise Program_Error with 795 "an interrupt entry is already installed"; 796 end if; 797 798 -- Note : Static = True will pass the following check. This is the 799 -- case when we want to detach a handler regardless of the static 800 -- status of the Current_Handler. 801 802 if not Static and then User_Handler (Interrupt).Static then 803 804 -- Trying to detach a static Interrupt Handler, raise 805 -- Program_Error. 806 807 raise Program_Error with 808 "trying to detach a static Interrupt Handler"; 809 end if; 810 811 Old_Handler := User_Handler (Interrupt).H; 812 813 -- The new handler 814 815 User_Handler (Interrupt).H := null; 816 User_Handler (Interrupt).Static := False; 817 818 if Old_Handler /= null then 819 Unbind_Handler (Interrupt); 820 end if; 821 end Unprotected_Detach_Handler; 822 823 ---------------------------------- 824 -- Unprotected_Exchange_Handler -- 825 ---------------------------------- 826 827 procedure Unprotected_Exchange_Handler 828 (Old_Handler : out Parameterless_Handler; 829 New_Handler : Parameterless_Handler; 830 Interrupt : Interrupt_ID; 831 Static : Boolean; 832 Restoration : Boolean := False) 833 is 834 begin 835 if User_Entry (Interrupt).T /= Null_Task then 836 837 -- If an interrupt entry is already installed, raise 838 -- Program_Error (propagate it to the caller). 839 840 raise Program_Error with "an interrupt is already installed"; 841 end if; 842 843 -- Note : A null handler with Static = True will pass the following 844 -- check. This is the case when we want to detach a handler 845 -- regardless of the Static status of Current_Handler. 846 847 -- We don't check anything if Restoration is True, since we may be 848 -- detaching a static handler to restore a dynamic one. 849 850 if not Restoration and then not Static 851 and then (User_Handler (Interrupt).Static 852 853 -- Trying to overwrite a static Interrupt Handler with a dynamic 854 -- Handler 855 856 -- The new handler is not specified as an Interrupt Handler by a 857 -- pragma. 858 859 or else not Is_Registered (New_Handler)) 860 then 861 raise Program_Error with 862 "trying to overwrite a static interrupt handler with a " 863 & "dynamic handler"; 864 end if; 865 866 -- Save the old handler 867 868 Old_Handler := User_Handler (Interrupt).H; 869 870 -- The new handler 871 872 User_Handler (Interrupt).H := New_Handler; 873 874 if New_Handler = null then 875 876 -- The null handler means we are detaching the handler 877 878 User_Handler (Interrupt).Static := False; 879 880 else 881 User_Handler (Interrupt).Static := Static; 882 end if; 883 884 -- Invoke a corresponding Server_Task if not yet created. Place 885 -- Task_Id info in Server_ID array. 886 887 if New_Handler /= null 888 and then 889 (Server_ID (Interrupt) = Null_Task 890 or else 891 Ada.Task_Identification.Is_Terminated 892 (To_Ada (Server_ID (Interrupt)))) 893 then 894 Interrupt_Access_Hold := 895 new Interrupt_Server_Task (Interrupt, Binary_Semaphore_Create); 896 Server_ID (Interrupt) := 897 To_System (Interrupt_Access_Hold.all'Identity); 898 end if; 899 900 if (New_Handler = null) and then Old_Handler /= null then 901 902 -- Restore default handler 903 904 Unbind_Handler (Interrupt); 905 906 elsif Old_Handler = null then 907 908 -- Save default handler 909 910 Bind_Handler (Interrupt); 911 end if; 912 end Unprotected_Exchange_Handler; 913 914 -- Start of processing for Interrupt_Manager 915 916 begin 917 loop 918 -- A block is needed to absorb Program_Error exception 919 920 declare 921 Old_Handler : Parameterless_Handler; 922 923 begin 924 select 925 accept Attach_Handler 926 (New_Handler : Parameterless_Handler; 927 Interrupt : Interrupt_ID; 928 Static : Boolean; 929 Restoration : Boolean := False) 930 do 931 Unprotected_Exchange_Handler 932 (Old_Handler, New_Handler, Interrupt, Static, Restoration); 933 end Attach_Handler; 934 935 or 936 accept Exchange_Handler 937 (Old_Handler : out Parameterless_Handler; 938 New_Handler : Parameterless_Handler; 939 Interrupt : Interrupt_ID; 940 Static : Boolean) 941 do 942 Unprotected_Exchange_Handler 943 (Old_Handler, New_Handler, Interrupt, Static); 944 end Exchange_Handler; 945 946 or 947 accept Detach_Handler 948 (Interrupt : Interrupt_ID; 949 Static : Boolean) 950 do 951 Unprotected_Detach_Handler (Interrupt, Static); 952 end Detach_Handler; 953 954 or 955 accept Bind_Interrupt_To_Entry 956 (T : Task_Id; 957 E : Task_Entry_Index; 958 Interrupt : Interrupt_ID) 959 do 960 -- If there is a binding already (either a procedure or an 961 -- entry), raise Program_Error (propagate it to the caller). 962 963 if User_Handler (Interrupt).H /= null 964 or else User_Entry (Interrupt).T /= Null_Task 965 then 966 raise Program_Error with 967 "a binding for this interrupt is already present"; 968 end if; 969 970 User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E); 971 972 -- Indicate the attachment of interrupt entry in the ATCB. 973 -- This is needed so when an interrupt entry task terminates 974 -- the binding can be cleaned. The call to unbinding must be 975 -- make by the task before it terminates. 976 977 T.Interrupt_Entry := True; 978 979 -- Invoke a corresponding Server_Task if not yet created. 980 -- Place Task_Id info in Server_ID array. 981 982 if Server_ID (Interrupt) = Null_Task 983 or else 984 Ada.Task_Identification.Is_Terminated 985 (To_Ada (Server_ID (Interrupt))) 986 then 987 Interrupt_Access_Hold := new Interrupt_Server_Task 988 (Interrupt, Binary_Semaphore_Create); 989 Server_ID (Interrupt) := 990 To_System (Interrupt_Access_Hold.all'Identity); 991 end if; 992 993 Bind_Handler (Interrupt); 994 end Bind_Interrupt_To_Entry; 995 996 or 997 accept Detach_Interrupt_Entries (T : Task_Id) do 998 for Int in Interrupt_ID'Range loop 999 if not Is_Reserved (Int) then 1000 if User_Entry (Int).T = T then 1001 User_Entry (Int) := 1002 Entry_Assoc' 1003 (T => Null_Task, E => Null_Task_Entry); 1004 Unbind_Handler (Int); 1005 end if; 1006 end if; 1007 end loop; 1008 1009 -- Indicate in ATCB that no interrupt entries are attached 1010 1011 T.Interrupt_Entry := False; 1012 end Detach_Interrupt_Entries; 1013 end select; 1014 1015 exception 1016 -- If there is a Program_Error we just want to propagate it to 1017 -- the caller and do not want to stop this task. 1018 1019 when Program_Error => 1020 null; 1021 1022 when others => 1023 pragma Assert (False); 1024 null; 1025 end; 1026 end loop; 1027 1028 exception 1029 when Standard'Abort_Signal => 1030 1031 -- Flush interrupt server semaphores, so they can terminate 1032 1033 Finalize_Interrupt_Servers; 1034 raise; 1035 end Interrupt_Manager; 1036 1037 --------------------------- 1038 -- Interrupt_Server_Task -- 1039 --------------------------- 1040 1041 -- Server task for vectored hardware interrupt handling 1042 1043 task body Interrupt_Server_Task is 1044 Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent; 1045 1046 Self_Id : constant Task_Id := Self; 1047 Tmp_Handler : Parameterless_Handler; 1048 Tmp_ID : Task_Id; 1049 Tmp_Entry_Index : Task_Entry_Index; 1050 Status : int; 1051 1052 begin 1053 Semaphore_ID_Map (Interrupt) := Int_Sema; 1054 1055 loop 1056 -- Pend on semaphore that will be triggered by the umbrella handler 1057 -- when the associated interrupt comes in. 1058 1059 Status := Binary_Semaphore_Obtain (Int_Sema); 1060 pragma Assert (Status = 0); 1061 1062 if User_Handler (Interrupt).H /= null then 1063 1064 -- Protected procedure handler 1065 1066 Tmp_Handler := User_Handler (Interrupt).H; 1067 Tmp_Handler.all; 1068 1069 elsif User_Entry (Interrupt).T /= Null_Task then 1070 1071 -- Interrupt entry handler 1072 1073 Tmp_ID := User_Entry (Interrupt).T; 1074 Tmp_Entry_Index := User_Entry (Interrupt).E; 1075 System.Tasking.Rendezvous.Call_Simple 1076 (Tmp_ID, Tmp_Entry_Index, System.Null_Address); 1077 1078 else 1079 -- Semaphore has been flushed by an unbind operation in the 1080 -- Interrupt_Manager. Terminate the server task. 1081 1082 -- Wait for the Interrupt_Manager to complete its work 1083 1084 POP.Write_Lock (Self_Id); 1085 1086 -- Unassociate the interrupt handler 1087 1088 Semaphore_ID_Map (Interrupt) := 0; 1089 1090 -- Delete the associated semaphore 1091 1092 Status := Binary_Semaphore_Delete (Int_Sema); 1093 1094 pragma Assert (Status = 0); 1095 1096 -- Set status for the Interrupt_Manager 1097 1098 Server_ID (Interrupt) := Null_Task; 1099 POP.Unlock (Self_Id); 1100 1101 exit; 1102 end if; 1103 end loop; 1104 end Interrupt_Server_Task; 1105 1106begin 1107 -- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent 1108 1109 Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity); 1110end System.Interrupts; 1111