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-2009, 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 interrupts are masked at all times in all 35-- tasks/threads except possibly for the Interrupt_Manager task. 36 37-- When a user task wants to have the effect of masking/unmasking an 38-- interrupt, it must call Block_Interrupt/Unblock_Interrupt, which 39-- will have the effect of unmasking/masking the interrupt in the 40-- Interrupt_Manager task. 41 42-- Note : Direct calls to sigaction, sigprocmask, pthread_sigsetmask or any 43-- other low-level interface that changes the interrupt action or 44-- interrupt mask needs a careful thought. 45-- One may achieve the effect of system calls first masking RTS blocked 46-- (by calling Block_Interrupt) for the interrupt under consideration. 47-- This will make all the tasks in RTS blocked for the Interrupt. 48 49-- Once we associate a Server_Task with an interrupt, the task never 50-- goes away, and we never remove the association. 51 52-- There is no more than one interrupt per Server_Task and no more than 53-- one Server_Task per interrupt. 54 55with Ada.Task_Identification; 56 57with System.Task_Primitives; 58with System.Interrupt_Management; 59 60with System.Interrupt_Management.Operations; 61pragma Elaborate_All (System.Interrupt_Management.Operations); 62 63with System.Task_Primitives.Operations; 64with System.Task_Primitives.Interrupt_Operations; 65with System.Storage_Elements; 66with System.Tasking.Utilities; 67 68with System.Tasking.Rendezvous; 69pragma Elaborate_All (System.Tasking.Rendezvous); 70 71with System.Tasking.Initialization; 72with System.Parameters; 73 74with Ada.Unchecked_Conversion; 75 76package body System.Interrupts is 77 78 use Parameters; 79 use Tasking; 80 81 package POP renames System.Task_Primitives.Operations; 82 package PIO renames System.Task_Primitives.Interrupt_Operations; 83 package IMNG renames System.Interrupt_Management; 84 package IMOP renames System.Interrupt_Management.Operations; 85 86 function To_System is new Ada.Unchecked_Conversion 87 (Ada.Task_Identification.Task_Id, Task_Id); 88 89 ----------------- 90 -- Local Tasks -- 91 ----------------- 92 93 -- WARNING: System.Tasking.Stages performs calls to this task with 94 -- low-level constructs. Do not change this spec without synchronizing it. 95 96 task Interrupt_Manager is 97 entry Detach_Interrupt_Entries (T : Task_Id); 98 99 entry Initialize (Mask : IMNG.Interrupt_Mask); 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 entry Block_Interrupt (Interrupt : Interrupt_ID); 123 124 entry Unblock_Interrupt (Interrupt : Interrupt_ID); 125 126 entry Ignore_Interrupt (Interrupt : Interrupt_ID); 127 128 entry Unignore_Interrupt (Interrupt : Interrupt_ID); 129 130 pragma Interrupt_Priority (System.Interrupt_Priority'Last); 131 end Interrupt_Manager; 132 133 task type Server_Task (Interrupt : Interrupt_ID) is 134 pragma Priority (System.Interrupt_Priority'Last); 135 -- Note: the above pragma Priority is strictly speaking improper since 136 -- it is outside the range of allowed priorities, but the compiler 137 -- treats system units specially and does not apply this range checking 138 -- rule to system units. 139 140 end Server_Task; 141 142 type Server_Task_Access is access Server_Task; 143 144 ------------------------------- 145 -- Local Types and Variables -- 146 ------------------------------- 147 148 type Entry_Assoc is record 149 T : Task_Id; 150 E : Task_Entry_Index; 151 end record; 152 153 type Handler_Assoc is record 154 H : Parameterless_Handler; 155 Static : Boolean; -- Indicates static binding; 156 end record; 157 158 User_Handler : array (Interrupt_ID'Range) of Handler_Assoc := 159 (others => (null, Static => False)); 160 pragma Volatile_Components (User_Handler); 161 -- Holds the protected procedure handler (if any) and its Static 162 -- information for each interrupt. A handler is a Static one if it is 163 -- specified through the pragma Attach_Handler. Attach_Handler. Otherwise, 164 -- not static) 165 166 User_Entry : array (Interrupt_ID'Range) of Entry_Assoc := 167 (others => (T => Null_Task, E => Null_Task_Entry)); 168 pragma Volatile_Components (User_Entry); 169 -- Holds the task and entry index (if any) for each interrupt 170 171 Blocked : array (Interrupt_ID'Range) of Boolean := (others => False); 172 pragma Atomic_Components (Blocked); 173 -- True iff the corresponding interrupt is blocked in the process level 174 175 Ignored : array (Interrupt_ID'Range) of Boolean := (others => False); 176 pragma Atomic_Components (Ignored); 177 -- True iff the corresponding interrupt is blocked in the process level 178 179 Last_Unblocker : 180 array (Interrupt_ID'Range) of Task_Id := (others => Null_Task); 181 pragma Atomic_Components (Last_Unblocker); 182 -- Holds the ID of the last Task which Unblocked this Interrupt. It 183 -- contains Null_Task if no tasks have ever requested the Unblocking 184 -- operation or the Interrupt is currently Blocked. 185 186 Server_ID : array (Interrupt_ID'Range) of Task_Id := 187 (others => Null_Task); 188 pragma Atomic_Components (Server_ID); 189 -- Holds the Task_Id of the Server_Task for each interrupt. Task_Id is 190 -- needed to accomplish locking per Interrupt base. Also is needed to 191 -- decide whether to create a new Server_Task. 192 193 -- Type and Head, Tail of the list containing Registered Interrupt 194 -- Handlers. These definitions are used to register the handlers 195 -- specified by the pragma Interrupt_Handler. 196 197 type Registered_Handler; 198 type R_Link is access all Registered_Handler; 199 200 type Registered_Handler is record 201 H : System.Address := System.Null_Address; 202 Next : R_Link := null; 203 end record; 204 205 Registered_Handler_Head : R_Link := null; 206 Registered_Handler_Tail : R_Link := null; 207 208 Access_Hold : Server_Task_Access; 209 -- Variable used to allocate Server_Task using "new" 210 211 ----------------------- 212 -- Local Subprograms -- 213 ----------------------- 214 215 function Is_Registered (Handler : Parameterless_Handler) return Boolean; 216 -- See if the Handler has been "pragma"ed using Interrupt_Handler. Always 217 -- consider a null handler as registered. 218 219 -------------------- 220 -- Attach_Handler -- 221 -------------------- 222 223 -- Calling this procedure with New_Handler = null and Static = True means 224 -- we want to detach the current handler regardless of the previous 225 -- handler's binding status (i.e. do not care if it is a dynamic or static 226 -- handler). 227 228 -- This option is needed so that during the finalization of a PO, we can 229 -- detach handlers attached through pragma Attach_Handler. 230 231 procedure Attach_Handler 232 (New_Handler : Parameterless_Handler; 233 Interrupt : Interrupt_ID; 234 Static : Boolean := False) 235 is 236 begin 237 if Is_Reserved (Interrupt) then 238 raise Program_Error with 239 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 240 end if; 241 242 Interrupt_Manager.Attach_Handler (New_Handler, Interrupt, Static); 243 244 end Attach_Handler; 245 246 ----------------------------- 247 -- Bind_Interrupt_To_Entry -- 248 ----------------------------- 249 250 -- This procedure raises a Program_Error if it tries to bind an interrupt 251 -- to which an Entry or a Procedure is already bound. 252 253 procedure Bind_Interrupt_To_Entry 254 (T : Task_Id; 255 E : Task_Entry_Index; 256 Int_Ref : System.Address) 257 is 258 Interrupt : constant Interrupt_ID := 259 Interrupt_ID (Storage_Elements.To_Integer (Int_Ref)); 260 261 begin 262 if Is_Reserved (Interrupt) then 263 raise Program_Error with 264 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 265 end if; 266 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 if Is_Reserved (Interrupt) then 277 raise Program_Error with 278 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 279 end if; 280 281 Interrupt_Manager.Block_Interrupt (Interrupt); 282 end Block_Interrupt; 283 284 --------------------- 285 -- Current_Handler -- 286 --------------------- 287 288 function Current_Handler 289 (Interrupt : Interrupt_ID) return Parameterless_Handler 290 is 291 begin 292 if Is_Reserved (Interrupt) then 293 raise Program_Error with 294 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 295 end if; 296 297 -- ??? Since Parameterless_Handler is not Atomic, the current 298 -- implementation is wrong. We need a new service in Interrupt_Manager 299 -- to ensure atomicity. 300 301 return User_Handler (Interrupt).H; 302 end Current_Handler; 303 304 -------------------- 305 -- Detach_Handler -- 306 -------------------- 307 308 -- Calling this procedure with Static = True means we want to Detach the 309 -- current handler regardless of the previous handler's binding status 310 -- (i.e. do not care if it is a dynamic or static handler). 311 312 -- This option is needed so that during the finalization of a PO, we can 313 -- detach handlers attached through pragma Attach_Handler. 314 315 procedure Detach_Handler 316 (Interrupt : Interrupt_ID; 317 Static : Boolean := False) 318 is 319 begin 320 if Is_Reserved (Interrupt) then 321 raise Program_Error with 322 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 323 end if; 324 325 Interrupt_Manager.Detach_Handler (Interrupt, Static); 326 end Detach_Handler; 327 328 ------------------------------ 329 -- Detach_Interrupt_Entries -- 330 ------------------------------ 331 332 procedure Detach_Interrupt_Entries (T : Task_Id) is 333 begin 334 Interrupt_Manager.Detach_Interrupt_Entries (T); 335 end Detach_Interrupt_Entries; 336 337 ---------------------- 338 -- Exchange_Handler -- 339 ---------------------- 340 341 -- Calling this procedure with New_Handler = null and Static = True means 342 -- we want to detach the current handler regardless of the previous 343 -- handler's binding status (i.e. do not care if it is a dynamic or static 344 -- handler). 345 346 -- This option is needed so that during the finalization of a PO, we can 347 -- detach handlers attached through pragma Attach_Handler. 348 349 procedure Exchange_Handler 350 (Old_Handler : out Parameterless_Handler; 351 New_Handler : Parameterless_Handler; 352 Interrupt : Interrupt_ID; 353 Static : Boolean := False) 354 is 355 begin 356 if Is_Reserved (Interrupt) then 357 raise Program_Error with 358 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 359 end if; 360 361 Interrupt_Manager.Exchange_Handler 362 (Old_Handler, New_Handler, Interrupt, Static); 363 end Exchange_Handler; 364 365 -------------- 366 -- Finalize -- 367 -------------- 368 369 procedure Finalize (Object : in out Static_Interrupt_Protection) is 370 function State 371 (Int : System.Interrupt_Management.Interrupt_ID) return Character; 372 pragma Import (C, State, "__gnat_get_interrupt_state"); 373 -- Get interrupt state for interrupt number Int. Defined in init.c 374 375 Default : constant Character := 's'; 376 -- 's' Interrupt_State pragma set state to System (use "default" 377 -- system handler) 378 379 begin 380 -- ??? loop to be executed only when we're not doing library level 381 -- finalization, since in this case all interrupt tasks are gone. 382 383 -- If the Abort_Task signal is set to system, it means that we cannot 384 -- reset interrupt handlers since this would require sending the abort 385 -- signal to the Server_Task 386 387 if not Interrupt_Manager'Terminated 388 and then State (System.Interrupt_Management.Abort_Task_Interrupt) 389 /= Default 390 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 -- Has_Interrupt_Or_Attach_Handler -- 406 ------------------------------------- 407 408 -- Need comments as to why these always return True ??? 409 410 function Has_Interrupt_Or_Attach_Handler 411 (Object : access Dynamic_Interrupt_Protection) return Boolean 412 is 413 pragma Unreferenced (Object); 414 begin 415 return True; 416 end Has_Interrupt_Or_Attach_Handler; 417 418 function Has_Interrupt_Or_Attach_Handler 419 (Object : access Static_Interrupt_Protection) return Boolean 420 is 421 pragma Unreferenced (Object); 422 begin 423 return True; 424 end Has_Interrupt_Or_Attach_Handler; 425 426 ---------------------- 427 -- Ignore_Interrupt -- 428 ---------------------- 429 430 procedure Ignore_Interrupt (Interrupt : Interrupt_ID) is 431 begin 432 if Is_Reserved (Interrupt) then 433 raise Program_Error with 434 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 435 end if; 436 437 Interrupt_Manager.Ignore_Interrupt (Interrupt); 438 end Ignore_Interrupt; 439 440 ---------------------- 441 -- Install_Handlers -- 442 ---------------------- 443 444 procedure Install_Handlers 445 (Object : access Static_Interrupt_Protection; 446 New_Handlers : New_Handler_Array) 447 is 448 begin 449 for N in New_Handlers'Range loop 450 451 -- We need a lock around this ??? 452 453 Object.Previous_Handlers (N).Interrupt := New_Handlers (N).Interrupt; 454 Object.Previous_Handlers (N).Static := User_Handler 455 (New_Handlers (N).Interrupt).Static; 456 457 -- We call Exchange_Handler and not directly Interrupt_Manager. 458 -- Exchange_Handler so we get the Is_Reserved check. 459 460 Exchange_Handler 461 (Old_Handler => Object.Previous_Handlers (N).Handler, 462 New_Handler => New_Handlers (N).Handler, 463 Interrupt => New_Handlers (N).Interrupt, 464 Static => True); 465 end loop; 466 end Install_Handlers; 467 468 --------------------------------- 469 -- Install_Restricted_Handlers -- 470 --------------------------------- 471 472 procedure Install_Restricted_Handlers (Handlers : New_Handler_Array) is 473 begin 474 for N in Handlers'Range loop 475 Attach_Handler (Handlers (N).Handler, Handlers (N).Interrupt, True); 476 end loop; 477 end Install_Restricted_Handlers; 478 479 ---------------- 480 -- Is_Blocked -- 481 ---------------- 482 483 function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is 484 begin 485 if Is_Reserved (Interrupt) then 486 raise Program_Error with 487 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 488 end if; 489 490 return Blocked (Interrupt); 491 end Is_Blocked; 492 493 ----------------------- 494 -- Is_Entry_Attached -- 495 ----------------------- 496 497 function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is 498 begin 499 if Is_Reserved (Interrupt) then 500 raise Program_Error with 501 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 502 end if; 503 504 return User_Entry (Interrupt).T /= Null_Task; 505 end Is_Entry_Attached; 506 507 ------------------------- 508 -- Is_Handler_Attached -- 509 ------------------------- 510 511 function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is 512 begin 513 if Is_Reserved (Interrupt) then 514 raise Program_Error with 515 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 516 end if; 517 518 return User_Handler (Interrupt).H /= null; 519 end Is_Handler_Attached; 520 521 ---------------- 522 -- Is_Ignored -- 523 ---------------- 524 525 function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is 526 begin 527 if Is_Reserved (Interrupt) then 528 raise Program_Error with 529 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 530 end if; 531 532 return Ignored (Interrupt); 533 end Is_Ignored; 534 535 ------------------- 536 -- Is_Registered -- 537 ------------------- 538 539 function Is_Registered (Handler : Parameterless_Handler) return Boolean is 540 541 type Fat_Ptr is record 542 Object_Addr : System.Address; 543 Handler_Addr : System.Address; 544 end record; 545 546 function To_Fat_Ptr is new Ada.Unchecked_Conversion 547 (Parameterless_Handler, Fat_Ptr); 548 549 Ptr : R_Link; 550 Fat : Fat_Ptr; 551 552 begin 553 if Handler = null then 554 return True; 555 end if; 556 557 Fat := To_Fat_Ptr (Handler); 558 559 Ptr := Registered_Handler_Head; 560 561 while Ptr /= null loop 562 if Ptr.H = Fat.Handler_Addr then 563 return True; 564 end if; 565 566 Ptr := Ptr.Next; 567 end loop; 568 569 return False; 570 end Is_Registered; 571 572 ----------------- 573 -- Is_Reserved -- 574 ----------------- 575 576 function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is 577 begin 578 return IMNG.Reserve (IMNG.Interrupt_ID (Interrupt)); 579 end Is_Reserved; 580 581 --------------- 582 -- Reference -- 583 --------------- 584 585 function Reference (Interrupt : Interrupt_ID) return System.Address is 586 begin 587 if Is_Reserved (Interrupt) then 588 raise Program_Error with 589 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 590 end if; 591 592 return Storage_Elements.To_Address 593 (Storage_Elements.Integer_Address (Interrupt)); 594 end Reference; 595 596 --------------------------------- 597 -- Register_Interrupt_Handler -- 598 --------------------------------- 599 600 procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is 601 New_Node_Ptr : R_Link; 602 603 begin 604 -- This routine registers the Handler as usable for Dynamic Interrupt 605 -- Handler. Routines attaching and detaching Handler dynamically should 606 -- first consult if the Handler is registered. A Program Error should 607 -- be raised if it is not registered. 608 609 -- The pragma Interrupt_Handler can only appear in the library level PO 610 -- definition and instantiation. Therefore, we do not need to implement 611 -- Unregistering operation. Neither we need to protect the queue 612 -- structure using a Lock. 613 614 pragma Assert (Handler_Addr /= System.Null_Address); 615 616 New_Node_Ptr := new Registered_Handler; 617 New_Node_Ptr.H := Handler_Addr; 618 619 if Registered_Handler_Head = null then 620 Registered_Handler_Head := New_Node_Ptr; 621 Registered_Handler_Tail := New_Node_Ptr; 622 623 else 624 Registered_Handler_Tail.Next := New_Node_Ptr; 625 Registered_Handler_Tail := New_Node_Ptr; 626 end if; 627 end Register_Interrupt_Handler; 628 629 ----------------------- 630 -- Unblock_Interrupt -- 631 ----------------------- 632 633 procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is 634 begin 635 if Is_Reserved (Interrupt) then 636 raise Program_Error with 637 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 638 end if; 639 640 Interrupt_Manager.Unblock_Interrupt (Interrupt); 641 end Unblock_Interrupt; 642 643 ------------------ 644 -- Unblocked_By -- 645 ------------------ 646 647 function Unblocked_By 648 (Interrupt : Interrupt_ID) return System.Tasking.Task_Id 649 is 650 begin 651 if Is_Reserved (Interrupt) then 652 raise Program_Error with 653 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 654 end if; 655 656 return Last_Unblocker (Interrupt); 657 end Unblocked_By; 658 659 ------------------------ 660 -- Unignore_Interrupt -- 661 ------------------------ 662 663 procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is 664 begin 665 if Is_Reserved (Interrupt) then 666 raise Program_Error with 667 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 668 end if; 669 670 Interrupt_Manager.Unignore_Interrupt (Interrupt); 671 end Unignore_Interrupt; 672 673 ----------------------- 674 -- Interrupt_Manager -- 675 ----------------------- 676 677 task body Interrupt_Manager is 678 679 --------------------- 680 -- Local Variables -- 681 --------------------- 682 683 Intwait_Mask : aliased IMNG.Interrupt_Mask; 684 Ret_Interrupt : Interrupt_ID; 685 Old_Mask : aliased IMNG.Interrupt_Mask; 686 Old_Handler : Parameterless_Handler; 687 688 -------------------- 689 -- Local Routines -- 690 -------------------- 691 692 procedure Bind_Handler (Interrupt : Interrupt_ID); 693 -- This procedure does not do anything if the Interrupt is blocked. 694 -- Otherwise, we have to interrupt Server_Task for status change through 695 -- Wakeup interrupt. 696 697 procedure Unbind_Handler (Interrupt : Interrupt_ID); 698 -- This procedure does not do anything if the Interrupt is blocked. 699 -- Otherwise, we have to interrupt Server_Task for status change 700 -- through abort interrupt. 701 702 procedure Unprotected_Exchange_Handler 703 (Old_Handler : out Parameterless_Handler; 704 New_Handler : Parameterless_Handler; 705 Interrupt : Interrupt_ID; 706 Static : Boolean; 707 Restoration : Boolean := False); 708 709 procedure Unprotected_Detach_Handler 710 (Interrupt : Interrupt_ID; 711 Static : Boolean); 712 713 ------------------ 714 -- Bind_Handler -- 715 ------------------ 716 717 procedure Bind_Handler (Interrupt : Interrupt_ID) is 718 begin 719 if not Blocked (Interrupt) then 720 721 -- Mask this task for the given Interrupt so that all tasks 722 -- are masked for the Interrupt and the actual delivery of the 723 -- Interrupt will be caught using "sigwait" by the 724 -- corresponding Server_Task. 725 726 IMOP.Thread_Block_Interrupt (IMNG.Interrupt_ID (Interrupt)); 727 728 -- We have installed a Handler or an Entry before we called 729 -- this procedure. If the Handler Task is waiting to be awakened, 730 -- do it here. Otherwise, the interrupt will be discarded. 731 732 POP.Wakeup (Server_ID (Interrupt), Interrupt_Server_Idle_Sleep); 733 end if; 734 end Bind_Handler; 735 736 -------------------- 737 -- Unbind_Handler -- 738 -------------------- 739 740 procedure Unbind_Handler (Interrupt : Interrupt_ID) is 741 Server : System.Tasking.Task_Id; 742 begin 743 if not Blocked (Interrupt) then 744 -- Currently, there is a Handler or an Entry attached and 745 -- corresponding Server_Task is waiting on "sigwait." 746 -- We have to wake up the Server_Task and make it 747 -- wait on condition variable by sending an 748 -- Abort_Task_Interrupt 749 750 Server := Server_ID (Interrupt); 751 752 case Server.Common.State is 753 when Interrupt_Server_Idle_Sleep | 754 Interrupt_Server_Blocked_Interrupt_Sleep 755 => 756 POP.Wakeup (Server, Server.Common.State); 757 758 when Interrupt_Server_Blocked_On_Event_Flag => 759 POP.Abort_Task (Server); 760 761 -- Make sure corresponding Server_Task is out of its 762 -- own sigwait state. 763 764 Ret_Interrupt := 765 Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access)); 766 pragma Assert 767 (Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt)); 768 769 when Runnable => 770 null; 771 772 when others => 773 pragma Assert (False); 774 null; 775 end case; 776 777 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt)); 778 779 -- Unmake the Interrupt for this task in order to allow default 780 -- action again. 781 782 IMOP.Thread_Unblock_Interrupt (IMNG.Interrupt_ID (Interrupt)); 783 784 else 785 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt)); 786 end if; 787 end Unbind_Handler; 788 789 -------------------------------- 790 -- Unprotected_Detach_Handler -- 791 -------------------------------- 792 793 procedure Unprotected_Detach_Handler 794 (Interrupt : Interrupt_ID; 795 Static : Boolean) 796 is 797 Old_Handler : Parameterless_Handler; 798 799 begin 800 if User_Entry (Interrupt).T /= Null_Task then 801 802 -- In case we have an Interrupt Entry installed. 803 -- raise a program error. (propagate it to the caller). 804 805 raise Program_Error with 806 "An interrupt entry is already installed"; 807 end if; 808 809 -- Note : Static = True will pass the following check. That is the 810 -- case when we want to detach a handler regardless of the static 811 -- status of the current_Handler. 812 813 if not Static and then User_Handler (Interrupt).Static then 814 815 -- Tries to detach a static Interrupt Handler. 816 -- raise a program error. 817 818 raise Program_Error with 819 "Trying to detach a static Interrupt Handler"; 820 end if; 821 822 -- The interrupt should no longer be ignored if 823 -- it was ever ignored. 824 825 Ignored (Interrupt) := False; 826 827 Old_Handler := User_Handler (Interrupt).H; 828 829 -- The new handler 830 831 User_Handler (Interrupt).H := null; 832 User_Handler (Interrupt).Static := False; 833 834 if Old_Handler /= null then 835 Unbind_Handler (Interrupt); 836 end if; 837 end Unprotected_Detach_Handler; 838 839 ---------------------------------- 840 -- Unprotected_Exchange_Handler -- 841 ---------------------------------- 842 843 procedure Unprotected_Exchange_Handler 844 (Old_Handler : out Parameterless_Handler; 845 New_Handler : Parameterless_Handler; 846 Interrupt : Interrupt_ID; 847 Static : Boolean; 848 Restoration : Boolean := False) 849 is 850 begin 851 if User_Entry (Interrupt).T /= Null_Task then 852 853 -- In case we have an Interrupt Entry already installed. 854 -- raise a program error. (propagate it to the caller). 855 856 raise Program_Error with 857 "An interrupt is already installed"; 858 end if; 859 860 -- Note : A null handler with Static = True will pass the 861 -- following check. That is the case when we want to Detach a 862 -- handler regardless of the Static status of the current_Handler. 863 864 -- We don't check anything if Restoration is True, since we 865 -- may be detaching a static handler to restore a dynamic one. 866 867 if not Restoration and then not Static 868 869 -- Tries to overwrite a static Interrupt Handler with a 870 -- dynamic Handler 871 872 and then (User_Handler (Interrupt).Static 873 874 -- The new handler is not specified as an 875 -- Interrupt Handler by a pragma. 876 877 or else not Is_Registered (New_Handler)) 878 then 879 raise Program_Error with 880 "Trying to overwrite a static Interrupt Handler with a " & 881 "dynamic Handler"; 882 end if; 883 884 -- The interrupt should no longer be ignored if 885 -- it was ever ignored. 886 887 Ignored (Interrupt) := False; 888 889 -- Save the old handler 890 891 Old_Handler := User_Handler (Interrupt).H; 892 893 -- The new handler 894 895 User_Handler (Interrupt).H := New_Handler; 896 897 if New_Handler = null then 898 899 -- The null handler means we are detaching the handler 900 901 User_Handler (Interrupt).Static := False; 902 903 else 904 User_Handler (Interrupt).Static := Static; 905 end if; 906 907 -- Invoke a corresponding Server_Task if not yet created. 908 -- Place Task_Id info in Server_ID array. 909 910 if Server_ID (Interrupt) = Null_Task then 911 912 -- When a new Server_Task is created, it should have its 913 -- signal mask set to the All_Tasks_Mask. 914 915 IMOP.Set_Interrupt_Mask 916 (IMOP.All_Tasks_Mask'Access, Old_Mask'Access); 917 Access_Hold := new Server_Task (Interrupt); 918 IMOP.Set_Interrupt_Mask (Old_Mask'Access); 919 920 Server_ID (Interrupt) := To_System (Access_Hold.all'Identity); 921 end if; 922 923 if New_Handler = null then 924 if Old_Handler /= null then 925 Unbind_Handler (Interrupt); 926 end if; 927 928 return; 929 end if; 930 931 if Old_Handler = null then 932 Bind_Handler (Interrupt); 933 end if; 934 end Unprotected_Exchange_Handler; 935 936 -- Start of processing for Interrupt_Manager 937 938 begin 939 -- By making this task independent of master, when the process 940 -- goes away, the Interrupt_Manager will terminate gracefully. 941 942 System.Tasking.Utilities.Make_Independent; 943 944 -- Environment task gets its own interrupt mask, saves it, 945 -- and then masks all interrupts except the Keep_Unmasked set. 946 947 -- During rendezvous, the Interrupt_Manager receives the old 948 -- interrupt mask of the environment task, and sets its own 949 -- interrupt mask to that value. 950 951 -- The environment task will call the entry of Interrupt_Manager some 952 -- during elaboration of the body of this package. 953 954 accept Initialize (Mask : IMNG.Interrupt_Mask) do 955 declare 956 The_Mask : aliased IMNG.Interrupt_Mask; 957 958 begin 959 IMOP.Copy_Interrupt_Mask (The_Mask, Mask); 960 IMOP.Set_Interrupt_Mask (The_Mask'Access); 961 end; 962 end Initialize; 963 964 -- Note: All tasks in RTS will have all the Reserve Interrupts 965 -- being masked (except the Interrupt_Manager) and Keep_Unmasked 966 -- unmasked when created. 967 968 -- Abort_Task_Interrupt is one of the Interrupt unmasked 969 -- in all tasks. We mask the Interrupt in this particular task 970 -- so that "sigwait" is possible to catch an explicitly sent 971 -- Abort_Task_Interrupt from the Server_Tasks. 972 973 -- This sigwaiting is needed so that we make sure a Server_Task is 974 -- out of its own sigwait state. This extra synchronization is 975 -- necessary to prevent following scenarios. 976 977 -- 1) Interrupt_Manager sends an Abort_Task_Interrupt to the 978 -- Server_Task then changes its own interrupt mask (OS level). 979 -- If an interrupt (corresponding to the Server_Task) arrives 980 -- in the mean time we have the Interrupt_Manager unmasked and 981 -- the Server_Task waiting on sigwait. 982 983 -- 2) For unbinding handler, we install a default action in the 984 -- Interrupt_Manager. POSIX.1c states that the result of using 985 -- "sigwait" and "sigaction" simultaneously on the same interrupt 986 -- is undefined. Therefore, we need to be informed from the 987 -- Server_Task of the fact that the Server_Task is out of its 988 -- sigwait stage. 989 990 IMOP.Empty_Interrupt_Mask (Intwait_Mask'Access); 991 IMOP.Add_To_Interrupt_Mask 992 (Intwait_Mask'Access, IMNG.Abort_Task_Interrupt); 993 IMOP.Thread_Block_Interrupt 994 (IMNG.Abort_Task_Interrupt); 995 996 loop 997 -- A block is needed to absorb Program_Error exception 998 999 begin 1000 select 1001 accept Attach_Handler 1002 (New_Handler : Parameterless_Handler; 1003 Interrupt : Interrupt_ID; 1004 Static : Boolean; 1005 Restoration : Boolean := False) 1006 do 1007 Unprotected_Exchange_Handler 1008 (Old_Handler, New_Handler, Interrupt, Static, Restoration); 1009 end Attach_Handler; 1010 1011 or 1012 accept Exchange_Handler 1013 (Old_Handler : out Parameterless_Handler; 1014 New_Handler : Parameterless_Handler; 1015 Interrupt : Interrupt_ID; 1016 Static : Boolean) 1017 do 1018 Unprotected_Exchange_Handler 1019 (Old_Handler, New_Handler, Interrupt, Static); 1020 end Exchange_Handler; 1021 1022 or 1023 accept Detach_Handler 1024 (Interrupt : Interrupt_ID; 1025 Static : Boolean) 1026 do 1027 Unprotected_Detach_Handler (Interrupt, Static); 1028 end Detach_Handler; 1029 1030 or 1031 accept Bind_Interrupt_To_Entry 1032 (T : Task_Id; 1033 E : Task_Entry_Index; 1034 Interrupt : Interrupt_ID) 1035 do 1036 -- if there is a binding already (either a procedure or an 1037 -- entry), raise Program_Error (propagate it to the caller). 1038 1039 if User_Handler (Interrupt).H /= null 1040 or else User_Entry (Interrupt).T /= Null_Task 1041 then 1042 raise Program_Error with 1043 "A binding for this interrupt is already present"; 1044 end if; 1045 1046 -- The interrupt should no longer be ignored if 1047 -- it was ever ignored. 1048 1049 Ignored (Interrupt) := False; 1050 User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E); 1051 1052 -- Indicate the attachment of Interrupt Entry in ATCB. 1053 -- This is need so that when an Interrupt Entry task 1054 -- terminates the binding can be cleaned. The call to 1055 -- unbinding must be made by the task before it terminates. 1056 1057 T.Interrupt_Entry := True; 1058 1059 -- Invoke a corresponding Server_Task if not yet created. 1060 -- Place Task_Id info in Server_ID array. 1061 1062 if Server_ID (Interrupt) = Null_Task then 1063 1064 -- When a new Server_Task is created, it should have its 1065 -- signal mask set to the All_Tasks_Mask. 1066 1067 IMOP.Set_Interrupt_Mask 1068 (IMOP.All_Tasks_Mask'Access, Old_Mask'Access); 1069 Access_Hold := new Server_Task (Interrupt); 1070 IMOP.Set_Interrupt_Mask (Old_Mask'Access); 1071 Server_ID (Interrupt) := 1072 To_System (Access_Hold.all'Identity); 1073 end if; 1074 1075 Bind_Handler (Interrupt); 1076 end Bind_Interrupt_To_Entry; 1077 1078 or 1079 accept Detach_Interrupt_Entries (T : Task_Id) do 1080 for J in Interrupt_ID'Range loop 1081 if not Is_Reserved (J) then 1082 if User_Entry (J).T = T then 1083 1084 -- The interrupt should no longer be ignored if 1085 -- it was ever ignored. 1086 1087 Ignored (J) := False; 1088 User_Entry (J) := Entry_Assoc' 1089 (T => Null_Task, E => Null_Task_Entry); 1090 Unbind_Handler (J); 1091 end if; 1092 end if; 1093 end loop; 1094 1095 -- Indicate in ATCB that no Interrupt Entries are attached 1096 1097 T.Interrupt_Entry := False; 1098 end Detach_Interrupt_Entries; 1099 1100 or 1101 accept Block_Interrupt (Interrupt : Interrupt_ID) do 1102 if Blocked (Interrupt) then 1103 return; 1104 end if; 1105 1106 Blocked (Interrupt) := True; 1107 Last_Unblocker (Interrupt) := Null_Task; 1108 1109 -- Mask this task for the given Interrupt so that all tasks 1110 -- are masked for the Interrupt. 1111 1112 IMOP.Thread_Block_Interrupt (IMNG.Interrupt_ID (Interrupt)); 1113 1114 if User_Handler (Interrupt).H /= null 1115 or else User_Entry (Interrupt).T /= Null_Task 1116 then 1117 -- This is the case where the Server_Task is waiting 1118 -- on "sigwait." Wake it up by sending an 1119 -- Abort_Task_Interrupt so that the Server_Task 1120 -- waits on Cond. 1121 1122 POP.Abort_Task (Server_ID (Interrupt)); 1123 1124 -- Make sure corresponding Server_Task is out of its own 1125 -- sigwait state. 1126 1127 Ret_Interrupt := Interrupt_ID 1128 (IMOP.Interrupt_Wait (Intwait_Mask'Access)); 1129 pragma Assert 1130 (Ret_Interrupt = 1131 Interrupt_ID (IMNG.Abort_Task_Interrupt)); 1132 end if; 1133 end Block_Interrupt; 1134 1135 or 1136 accept Unblock_Interrupt (Interrupt : Interrupt_ID) do 1137 if not Blocked (Interrupt) then 1138 return; 1139 end if; 1140 1141 Blocked (Interrupt) := False; 1142 Last_Unblocker (Interrupt) := 1143 To_System (Unblock_Interrupt'Caller); 1144 1145 if User_Handler (Interrupt).H = null 1146 and then User_Entry (Interrupt).T = Null_Task 1147 then 1148 -- No handler is attached. Unmask the Interrupt so that 1149 -- the default action can be carried out. 1150 1151 IMOP.Thread_Unblock_Interrupt 1152 (IMNG.Interrupt_ID (Interrupt)); 1153 1154 else 1155 -- The Server_Task must be waiting on the Cond variable 1156 -- since it was being blocked and an Interrupt Hander or 1157 -- an Entry was there. Wake it up and let it change 1158 -- it place of waiting according to its new state. 1159 1160 POP.Wakeup (Server_ID (Interrupt), 1161 Interrupt_Server_Blocked_Interrupt_Sleep); 1162 end if; 1163 end Unblock_Interrupt; 1164 1165 or 1166 accept Ignore_Interrupt (Interrupt : Interrupt_ID) do 1167 if Ignored (Interrupt) then 1168 return; 1169 end if; 1170 1171 Ignored (Interrupt) := True; 1172 1173 -- If there is a handler associated with the Interrupt, 1174 -- detach it first. In this way we make sure that the 1175 -- Server_Task is not on sigwait. This is legal since 1176 -- Unignore_Interrupt is to install the default action. 1177 1178 if User_Handler (Interrupt).H /= null then 1179 Unprotected_Detach_Handler 1180 (Interrupt => Interrupt, Static => True); 1181 1182 elsif User_Entry (Interrupt).T /= Null_Task then 1183 User_Entry (Interrupt) := Entry_Assoc' 1184 (T => Null_Task, E => Null_Task_Entry); 1185 Unbind_Handler (Interrupt); 1186 end if; 1187 1188 IMOP.Install_Ignore_Action (IMNG.Interrupt_ID (Interrupt)); 1189 end Ignore_Interrupt; 1190 1191 or 1192 accept Unignore_Interrupt (Interrupt : Interrupt_ID) do 1193 Ignored (Interrupt) := False; 1194 1195 -- If there is a handler associated with the Interrupt, 1196 -- detach it first. In this way we make sure that the 1197 -- Server_Task is not on sigwait. This is legal since 1198 -- Unignore_Interrupt is to install the default action. 1199 1200 if User_Handler (Interrupt).H /= null then 1201 Unprotected_Detach_Handler 1202 (Interrupt => Interrupt, Static => True); 1203 1204 elsif User_Entry (Interrupt).T /= Null_Task then 1205 User_Entry (Interrupt) := Entry_Assoc' 1206 (T => Null_Task, E => Null_Task_Entry); 1207 Unbind_Handler (Interrupt); 1208 end if; 1209 1210 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt)); 1211 end Unignore_Interrupt; 1212 end select; 1213 1214 exception 1215 -- If there is a program error we just want to propagate it to 1216 -- the caller and do not want to stop this task. 1217 1218 when Program_Error => 1219 null; 1220 1221 when others => 1222 pragma Assert (False); 1223 null; 1224 end; 1225 end loop; 1226 end Interrupt_Manager; 1227 1228 ----------------- 1229 -- Server_Task -- 1230 ----------------- 1231 1232 task body Server_Task is 1233 Intwait_Mask : aliased IMNG.Interrupt_Mask; 1234 Ret_Interrupt : Interrupt_ID; 1235 Self_ID : constant Task_Id := Self; 1236 Tmp_Handler : Parameterless_Handler; 1237 Tmp_ID : Task_Id; 1238 Tmp_Entry_Index : Task_Entry_Index; 1239 1240 begin 1241 -- By making this task independent of master, when the process 1242 -- goes away, the Server_Task will terminate gracefully. 1243 1244 System.Tasking.Utilities.Make_Independent; 1245 1246 -- Install default action in system level 1247 1248 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt)); 1249 1250 -- Note: All tasks in RTS will have all the Reserve Interrupts being 1251 -- masked (except the Interrupt_Manager) and Keep_Unmasked unmasked when 1252 -- created. 1253 1254 -- Abort_Task_Interrupt is one of the Interrupt unmasked in all tasks. 1255 -- We mask the Interrupt in this particular task so that "sigwait" is 1256 -- possible to catch an explicitly sent Abort_Task_Interrupt from the 1257 -- Interrupt_Manager. 1258 1259 -- There are two Interrupt interrupts that this task catch through 1260 -- "sigwait." One is the Interrupt this task is designated to catch 1261 -- in order to execute user handler or entry. The other one is the 1262 -- Abort_Task_Interrupt. This interrupt is being sent from the 1263 -- Interrupt_Manager to inform status changes (e.g: become Blocked, 1264 -- Handler or Entry is to be detached). 1265 1266 -- Prepare a mask to used for sigwait 1267 1268 IMOP.Empty_Interrupt_Mask (Intwait_Mask'Access); 1269 1270 IMOP.Add_To_Interrupt_Mask 1271 (Intwait_Mask'Access, IMNG.Interrupt_ID (Interrupt)); 1272 1273 IMOP.Add_To_Interrupt_Mask 1274 (Intwait_Mask'Access, IMNG.Abort_Task_Interrupt); 1275 1276 IMOP.Thread_Block_Interrupt 1277 (IMNG.Abort_Task_Interrupt); 1278 1279 PIO.Set_Interrupt_ID (IMNG.Interrupt_ID (Interrupt), Self_ID); 1280 1281 loop 1282 System.Tasking.Initialization.Defer_Abort (Self_ID); 1283 1284 if Single_Lock then 1285 POP.Lock_RTS; 1286 end if; 1287 1288 POP.Write_Lock (Self_ID); 1289 1290 if User_Handler (Interrupt).H = null 1291 and then User_Entry (Interrupt).T = Null_Task 1292 then 1293 -- No Interrupt binding. If there is an interrupt, 1294 -- Interrupt_Manager will take default action. 1295 1296 Self_ID.Common.State := Interrupt_Server_Blocked_Interrupt_Sleep; 1297 POP.Sleep (Self_ID, Interrupt_Server_Idle_Sleep); 1298 Self_ID.Common.State := Runnable; 1299 1300 elsif Blocked (Interrupt) then 1301 1302 -- Interrupt is blocked. Stay here, so we won't catch 1303 -- the Interrupt. 1304 1305 Self_ID.Common.State := Interrupt_Server_Blocked_Interrupt_Sleep; 1306 POP.Sleep (Self_ID, Interrupt_Server_Blocked_Interrupt_Sleep); 1307 Self_ID.Common.State := Runnable; 1308 1309 else 1310 -- A Handler or an Entry is installed. At this point all tasks 1311 -- mask for the Interrupt is masked. Catch the Interrupt using 1312 -- sigwait. 1313 1314 -- This task may wake up from sigwait by receiving an interrupt 1315 -- (Abort_Task_Interrupt) from the Interrupt_Manager for unbinding 1316 -- a Procedure Handler or an Entry. Or it could be a wake up 1317 -- from status change (Unblocked -> Blocked). If that is not 1318 -- the case, we should execute the attached Procedure or Entry. 1319 1320 Self_ID.Common.State := Interrupt_Server_Blocked_On_Event_Flag; 1321 POP.Unlock (Self_ID); 1322 1323 if Single_Lock then 1324 POP.Unlock_RTS; 1325 end if; 1326 1327 -- Avoid race condition when terminating application and 1328 -- System.Parameters.No_Abort is True. 1329 1330 if Parameters.No_Abort and then Self_ID.Pending_Action then 1331 Initialization.Do_Pending_Action (Self_ID); 1332 end if; 1333 1334 Ret_Interrupt := 1335 Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access)); 1336 Self_ID.Common.State := Runnable; 1337 1338 if Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt) then 1339 1340 -- Inform the Interrupt_Manager of wakeup from above sigwait 1341 1342 POP.Abort_Task (Interrupt_Manager_ID); 1343 1344 if Single_Lock then 1345 POP.Lock_RTS; 1346 end if; 1347 1348 POP.Write_Lock (Self_ID); 1349 1350 else 1351 if Single_Lock then 1352 POP.Lock_RTS; 1353 end if; 1354 1355 POP.Write_Lock (Self_ID); 1356 1357 if Ret_Interrupt /= Interrupt then 1358 1359 -- On some systems (e.g. recent linux kernels), sigwait 1360 -- may return unexpectedly (with errno set to EINTR). 1361 1362 null; 1363 1364 else 1365 -- Even though we have received an Interrupt the status may 1366 -- have changed already before we got the Self_ID lock above 1367 -- Therefore we make sure a Handler or an Entry is still 1368 -- there and make appropriate call. 1369 1370 -- If there is no calls to make we need to regenerate the 1371 -- Interrupt in order not to lose it. 1372 1373 if User_Handler (Interrupt).H /= null then 1374 Tmp_Handler := User_Handler (Interrupt).H; 1375 1376 -- RTS calls should not be made with self being locked 1377 1378 POP.Unlock (Self_ID); 1379 1380 if Single_Lock then 1381 POP.Unlock_RTS; 1382 end if; 1383 1384 Tmp_Handler.all; 1385 1386 if Single_Lock then 1387 POP.Lock_RTS; 1388 end if; 1389 1390 POP.Write_Lock (Self_ID); 1391 1392 elsif User_Entry (Interrupt).T /= Null_Task then 1393 Tmp_ID := User_Entry (Interrupt).T; 1394 Tmp_Entry_Index := User_Entry (Interrupt).E; 1395 1396 -- RTS calls should not be made with self being locked 1397 1398 if Single_Lock then 1399 POP.Unlock_RTS; 1400 end if; 1401 1402 POP.Unlock (Self_ID); 1403 1404 System.Tasking.Rendezvous.Call_Simple 1405 (Tmp_ID, Tmp_Entry_Index, System.Null_Address); 1406 1407 POP.Write_Lock (Self_ID); 1408 1409 if Single_Lock then 1410 POP.Lock_RTS; 1411 end if; 1412 1413 else 1414 -- This is a situation that this task wakes up receiving 1415 -- an Interrupt and before it gets the lock the Interrupt 1416 -- is blocked. We do not want to lose the interrupt in 1417 -- this case so we regenerate the Interrupt to process 1418 -- level. 1419 1420 IMOP.Interrupt_Self_Process 1421 (IMNG.Interrupt_ID (Interrupt)); 1422 end if; 1423 end if; 1424 end if; 1425 end if; 1426 1427 POP.Unlock (Self_ID); 1428 1429 if Single_Lock then 1430 POP.Unlock_RTS; 1431 end if; 1432 1433 System.Tasking.Initialization.Undefer_Abort (Self_ID); 1434 1435 if Self_ID.Pending_Action then 1436 Initialization.Do_Pending_Action (Self_ID); 1437 end if; 1438 1439 -- Undefer abort here to allow a window for this task to be aborted 1440 -- at the time of system shutdown. We also explicitly test for 1441 -- Pending_Action in case System.Parameters.No_Abort is True. 1442 1443 end loop; 1444 end Server_Task; 1445 1446-- Elaboration code for package System.Interrupts 1447 1448begin 1449 -- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent 1450 1451 Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity); 1452 1453 -- During the elaboration of this package body we want the RTS 1454 -- to inherit the interrupt mask from the Environment Task. 1455 1456 IMOP.Setup_Interrupt_Mask; 1457 1458 -- The environment task should have gotten its mask from the enclosing 1459 -- process during the RTS start up. (See processing in s-inmaop.adb). Pass 1460 -- the Interrupt_Mask of the environment task to the Interrupt_Manager. 1461 1462 -- Note: At this point we know that all tasks are masked for non-reserved 1463 -- signals. Only the Interrupt_Manager will have masks set up differently 1464 -- inheriting the original environment task's mask. 1465 1466 Interrupt_Manager.Initialize (IMOP.Environment_Mask); 1467end System.Interrupts; 1468