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