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