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