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-2013, 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 473 (Prio : Any_Priority; 474 Handlers : New_Handler_Array) 475 is 476 pragma Unreferenced (Prio); 477 begin 478 for N in Handlers'Range loop 479 Attach_Handler (Handlers (N).Handler, Handlers (N).Interrupt, True); 480 end loop; 481 end Install_Restricted_Handlers; 482 483 ---------------- 484 -- Is_Blocked -- 485 ---------------- 486 487 function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is 488 begin 489 if Is_Reserved (Interrupt) then 490 raise Program_Error with 491 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 492 end if; 493 494 return Blocked (Interrupt); 495 end Is_Blocked; 496 497 ----------------------- 498 -- Is_Entry_Attached -- 499 ----------------------- 500 501 function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is 502 begin 503 if Is_Reserved (Interrupt) then 504 raise Program_Error with 505 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 506 end if; 507 508 return User_Entry (Interrupt).T /= Null_Task; 509 end Is_Entry_Attached; 510 511 ------------------------- 512 -- Is_Handler_Attached -- 513 ------------------------- 514 515 function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is 516 begin 517 if Is_Reserved (Interrupt) then 518 raise Program_Error with 519 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 520 end if; 521 522 return User_Handler (Interrupt).H /= null; 523 end Is_Handler_Attached; 524 525 ---------------- 526 -- Is_Ignored -- 527 ---------------- 528 529 function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is 530 begin 531 if Is_Reserved (Interrupt) then 532 raise Program_Error with 533 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 534 end if; 535 536 return Ignored (Interrupt); 537 end Is_Ignored; 538 539 ------------------- 540 -- Is_Registered -- 541 ------------------- 542 543 function Is_Registered (Handler : Parameterless_Handler) return Boolean is 544 545 type Fat_Ptr is record 546 Object_Addr : System.Address; 547 Handler_Addr : System.Address; 548 end record; 549 550 function To_Fat_Ptr is new Ada.Unchecked_Conversion 551 (Parameterless_Handler, Fat_Ptr); 552 553 Ptr : R_Link; 554 Fat : Fat_Ptr; 555 556 begin 557 if Handler = null then 558 return True; 559 end if; 560 561 Fat := To_Fat_Ptr (Handler); 562 563 Ptr := Registered_Handler_Head; 564 565 while Ptr /= null loop 566 if Ptr.H = Fat.Handler_Addr then 567 return True; 568 end if; 569 570 Ptr := Ptr.Next; 571 end loop; 572 573 return False; 574 end Is_Registered; 575 576 ----------------- 577 -- Is_Reserved -- 578 ----------------- 579 580 function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is 581 begin 582 return IMNG.Reserve (IMNG.Interrupt_ID (Interrupt)); 583 end Is_Reserved; 584 585 --------------- 586 -- Reference -- 587 --------------- 588 589 function Reference (Interrupt : Interrupt_ID) return System.Address is 590 begin 591 if Is_Reserved (Interrupt) then 592 raise Program_Error with 593 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 594 end if; 595 596 return Storage_Elements.To_Address 597 (Storage_Elements.Integer_Address (Interrupt)); 598 end Reference; 599 600 --------------------------------- 601 -- Register_Interrupt_Handler -- 602 --------------------------------- 603 604 procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is 605 New_Node_Ptr : R_Link; 606 607 begin 608 -- This routine registers the Handler as usable for Dynamic Interrupt 609 -- Handler. Routines attaching and detaching Handler dynamically should 610 -- first consult if the Handler is registered. A Program Error should 611 -- be raised if it is not registered. 612 613 -- The pragma Interrupt_Handler can only appear in the library level PO 614 -- definition and instantiation. Therefore, we do not need to implement 615 -- Unregistering operation. Neither we need to protect the queue 616 -- structure using a Lock. 617 618 pragma Assert (Handler_Addr /= System.Null_Address); 619 620 New_Node_Ptr := new Registered_Handler; 621 New_Node_Ptr.H := Handler_Addr; 622 623 if Registered_Handler_Head = null then 624 Registered_Handler_Head := New_Node_Ptr; 625 Registered_Handler_Tail := New_Node_Ptr; 626 627 else 628 Registered_Handler_Tail.Next := New_Node_Ptr; 629 Registered_Handler_Tail := New_Node_Ptr; 630 end if; 631 end Register_Interrupt_Handler; 632 633 ----------------------- 634 -- Unblock_Interrupt -- 635 ----------------------- 636 637 procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is 638 begin 639 if Is_Reserved (Interrupt) then 640 raise Program_Error with 641 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 642 end if; 643 644 Interrupt_Manager.Unblock_Interrupt (Interrupt); 645 end Unblock_Interrupt; 646 647 ------------------ 648 -- Unblocked_By -- 649 ------------------ 650 651 function Unblocked_By 652 (Interrupt : Interrupt_ID) return System.Tasking.Task_Id 653 is 654 begin 655 if Is_Reserved (Interrupt) then 656 raise Program_Error with 657 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 658 end if; 659 660 return Last_Unblocker (Interrupt); 661 end Unblocked_By; 662 663 ------------------------ 664 -- Unignore_Interrupt -- 665 ------------------------ 666 667 procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is 668 begin 669 if Is_Reserved (Interrupt) then 670 raise Program_Error with 671 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; 672 end if; 673 674 Interrupt_Manager.Unignore_Interrupt (Interrupt); 675 end Unignore_Interrupt; 676 677 ----------------------- 678 -- Interrupt_Manager -- 679 ----------------------- 680 681 task body Interrupt_Manager is 682 683 --------------------- 684 -- Local Variables -- 685 --------------------- 686 687 Intwait_Mask : aliased IMNG.Interrupt_Mask; 688 Ret_Interrupt : Interrupt_ID; 689 Old_Mask : aliased IMNG.Interrupt_Mask; 690 Old_Handler : Parameterless_Handler; 691 692 -------------------- 693 -- Local Routines -- 694 -------------------- 695 696 procedure Bind_Handler (Interrupt : Interrupt_ID); 697 -- This procedure does not do anything if the Interrupt is blocked. 698 -- Otherwise, we have to interrupt Server_Task for status change through 699 -- Wakeup interrupt. 700 701 procedure Unbind_Handler (Interrupt : Interrupt_ID); 702 -- This procedure does not do anything if the Interrupt is blocked. 703 -- Otherwise, we have to interrupt Server_Task for status change 704 -- through abort interrupt. 705 706 procedure Unprotected_Exchange_Handler 707 (Old_Handler : out Parameterless_Handler; 708 New_Handler : Parameterless_Handler; 709 Interrupt : Interrupt_ID; 710 Static : Boolean; 711 Restoration : Boolean := False); 712 713 procedure Unprotected_Detach_Handler 714 (Interrupt : Interrupt_ID; 715 Static : Boolean); 716 717 ------------------ 718 -- Bind_Handler -- 719 ------------------ 720 721 procedure Bind_Handler (Interrupt : Interrupt_ID) is 722 begin 723 if not Blocked (Interrupt) then 724 725 -- Mask this task for the given Interrupt so that all tasks 726 -- are masked for the Interrupt and the actual delivery of the 727 -- Interrupt will be caught using "sigwait" by the 728 -- corresponding Server_Task. 729 730 IMOP.Thread_Block_Interrupt (IMNG.Interrupt_ID (Interrupt)); 731 732 -- We have installed a Handler or an Entry before we called 733 -- this procedure. If the Handler Task is waiting to be awakened, 734 -- do it here. Otherwise, the interrupt will be discarded. 735 736 POP.Wakeup (Server_ID (Interrupt), Interrupt_Server_Idle_Sleep); 737 end if; 738 end Bind_Handler; 739 740 -------------------- 741 -- Unbind_Handler -- 742 -------------------- 743 744 procedure Unbind_Handler (Interrupt : Interrupt_ID) is 745 Server : System.Tasking.Task_Id; 746 begin 747 if not Blocked (Interrupt) then 748 -- Currently, there is a Handler or an Entry attached and 749 -- corresponding Server_Task is waiting on "sigwait." 750 -- We have to wake up the Server_Task and make it 751 -- wait on condition variable by sending an 752 -- Abort_Task_Interrupt 753 754 Server := Server_ID (Interrupt); 755 756 case Server.Common.State is 757 when Interrupt_Server_Idle_Sleep | 758 Interrupt_Server_Blocked_Interrupt_Sleep 759 => 760 POP.Wakeup (Server, Server.Common.State); 761 762 when Interrupt_Server_Blocked_On_Event_Flag => 763 POP.Abort_Task (Server); 764 765 -- Make sure corresponding Server_Task is out of its 766 -- own sigwait state. 767 768 Ret_Interrupt := 769 Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access)); 770 pragma Assert 771 (Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt)); 772 773 when Runnable => 774 null; 775 776 when others => 777 pragma Assert (False); 778 null; 779 end case; 780 781 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt)); 782 783 -- Unmake the Interrupt for this task in order to allow default 784 -- action again. 785 786 IMOP.Thread_Unblock_Interrupt (IMNG.Interrupt_ID (Interrupt)); 787 788 else 789 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt)); 790 end if; 791 end Unbind_Handler; 792 793 -------------------------------- 794 -- Unprotected_Detach_Handler -- 795 -------------------------------- 796 797 procedure Unprotected_Detach_Handler 798 (Interrupt : Interrupt_ID; 799 Static : Boolean) 800 is 801 Old_Handler : Parameterless_Handler; 802 803 begin 804 if User_Entry (Interrupt).T /= Null_Task then 805 806 -- In case we have an Interrupt Entry installed. 807 -- raise a program error. (propagate it to the caller). 808 809 raise Program_Error with 810 "An interrupt entry is already installed"; 811 end if; 812 813 -- Note : Static = True will pass the following check. That is the 814 -- case when we want to detach a handler regardless of the static 815 -- status of the current_Handler. 816 817 if not Static and then User_Handler (Interrupt).Static then 818 819 -- Tries to detach a static Interrupt Handler. 820 -- raise a program error. 821 822 raise Program_Error with 823 "Trying to detach a static Interrupt Handler"; 824 end if; 825 826 -- The interrupt should no longer be ignored if 827 -- it was ever ignored. 828 829 Ignored (Interrupt) := False; 830 831 Old_Handler := User_Handler (Interrupt).H; 832 833 -- The new handler 834 835 User_Handler (Interrupt).H := null; 836 User_Handler (Interrupt).Static := False; 837 838 if Old_Handler /= null then 839 Unbind_Handler (Interrupt); 840 end if; 841 end Unprotected_Detach_Handler; 842 843 ---------------------------------- 844 -- Unprotected_Exchange_Handler -- 845 ---------------------------------- 846 847 procedure Unprotected_Exchange_Handler 848 (Old_Handler : out Parameterless_Handler; 849 New_Handler : Parameterless_Handler; 850 Interrupt : Interrupt_ID; 851 Static : Boolean; 852 Restoration : Boolean := False) 853 is 854 begin 855 if User_Entry (Interrupt).T /= Null_Task then 856 857 -- In case we have an Interrupt Entry already installed. 858 -- raise a program error. (propagate it to the caller). 859 860 raise Program_Error with 861 "An interrupt is already installed"; 862 end if; 863 864 -- Note : A null handler with Static = True will pass the 865 -- following check. That is the case when we want to Detach a 866 -- handler regardless of the Static status of the current_Handler. 867 868 -- We don't check anything if Restoration is True, since we 869 -- may be detaching a static handler to restore a dynamic one. 870 871 if not Restoration and then not Static 872 873 -- Tries to overwrite a static Interrupt Handler with a 874 -- dynamic Handler 875 876 and then (User_Handler (Interrupt).Static 877 878 -- The new handler is not specified as an 879 -- Interrupt Handler by a pragma. 880 881 or else not Is_Registered (New_Handler)) 882 then 883 raise Program_Error with 884 "Trying to overwrite a static Interrupt Handler with a " & 885 "dynamic Handler"; 886 end if; 887 888 -- The interrupt should no longer be ignored if 889 -- it was ever ignored. 890 891 Ignored (Interrupt) := False; 892 893 -- Save the old handler 894 895 Old_Handler := User_Handler (Interrupt).H; 896 897 -- The new handler 898 899 User_Handler (Interrupt).H := New_Handler; 900 901 if New_Handler = null then 902 903 -- The null handler means we are detaching the handler 904 905 User_Handler (Interrupt).Static := False; 906 907 else 908 User_Handler (Interrupt).Static := Static; 909 end if; 910 911 -- Invoke a corresponding Server_Task if not yet created. 912 -- Place Task_Id info in Server_ID array. 913 914 if Server_ID (Interrupt) = Null_Task then 915 916 -- When a new Server_Task is created, it should have its 917 -- signal mask set to the All_Tasks_Mask. 918 919 IMOP.Set_Interrupt_Mask 920 (IMOP.All_Tasks_Mask'Access, Old_Mask'Access); 921 Access_Hold := new Server_Task (Interrupt); 922 IMOP.Set_Interrupt_Mask (Old_Mask'Access); 923 924 Server_ID (Interrupt) := To_System (Access_Hold.all'Identity); 925 end if; 926 927 if New_Handler = null then 928 if Old_Handler /= null then 929 Unbind_Handler (Interrupt); 930 end if; 931 932 return; 933 end if; 934 935 if Old_Handler = null then 936 Bind_Handler (Interrupt); 937 end if; 938 end Unprotected_Exchange_Handler; 939 940 -- Start of processing for Interrupt_Manager 941 942 begin 943 -- By making this task independent of master, when the process 944 -- goes away, the Interrupt_Manager will terminate gracefully. 945 946 System.Tasking.Utilities.Make_Independent; 947 948 -- Environment task gets its own interrupt mask, saves it, 949 -- and then masks all interrupts except the Keep_Unmasked set. 950 951 -- During rendezvous, the Interrupt_Manager receives the old 952 -- interrupt mask of the environment task, and sets its own 953 -- interrupt mask to that value. 954 955 -- The environment task will call the entry of Interrupt_Manager some 956 -- during elaboration of the body of this package. 957 958 accept Initialize (Mask : IMNG.Interrupt_Mask) do 959 declare 960 The_Mask : aliased IMNG.Interrupt_Mask; 961 962 begin 963 IMOP.Copy_Interrupt_Mask (The_Mask, Mask); 964 IMOP.Set_Interrupt_Mask (The_Mask'Access); 965 end; 966 end Initialize; 967 968 -- Note: All tasks in RTS will have all the Reserve Interrupts 969 -- being masked (except the Interrupt_Manager) and Keep_Unmasked 970 -- unmasked when created. 971 972 -- Abort_Task_Interrupt is one of the Interrupt unmasked 973 -- in all tasks. We mask the Interrupt in this particular task 974 -- so that "sigwait" is possible to catch an explicitly sent 975 -- Abort_Task_Interrupt from the Server_Tasks. 976 977 -- This sigwaiting is needed so that we make sure a Server_Task is 978 -- out of its own sigwait state. This extra synchronization is 979 -- necessary to prevent following scenarios. 980 981 -- 1) Interrupt_Manager sends an Abort_Task_Interrupt to the 982 -- Server_Task then changes its own interrupt mask (OS level). 983 -- If an interrupt (corresponding to the Server_Task) arrives 984 -- in the mean time we have the Interrupt_Manager unmasked and 985 -- the Server_Task waiting on sigwait. 986 987 -- 2) For unbinding handler, we install a default action in the 988 -- Interrupt_Manager. POSIX.1c states that the result of using 989 -- "sigwait" and "sigaction" simultaneously on the same interrupt 990 -- is undefined. Therefore, we need to be informed from the 991 -- Server_Task of the fact that the Server_Task is out of its 992 -- sigwait stage. 993 994 IMOP.Empty_Interrupt_Mask (Intwait_Mask'Access); 995 IMOP.Add_To_Interrupt_Mask 996 (Intwait_Mask'Access, IMNG.Abort_Task_Interrupt); 997 IMOP.Thread_Block_Interrupt 998 (IMNG.Abort_Task_Interrupt); 999 1000 loop 1001 -- A block is needed to absorb Program_Error exception 1002 1003 begin 1004 select 1005 accept Attach_Handler 1006 (New_Handler : Parameterless_Handler; 1007 Interrupt : Interrupt_ID; 1008 Static : Boolean; 1009 Restoration : Boolean := False) 1010 do 1011 Unprotected_Exchange_Handler 1012 (Old_Handler, New_Handler, Interrupt, Static, Restoration); 1013 end Attach_Handler; 1014 1015 or 1016 accept Exchange_Handler 1017 (Old_Handler : out Parameterless_Handler; 1018 New_Handler : Parameterless_Handler; 1019 Interrupt : Interrupt_ID; 1020 Static : Boolean) 1021 do 1022 Unprotected_Exchange_Handler 1023 (Old_Handler, New_Handler, Interrupt, Static); 1024 end Exchange_Handler; 1025 1026 or 1027 accept Detach_Handler 1028 (Interrupt : Interrupt_ID; 1029 Static : Boolean) 1030 do 1031 Unprotected_Detach_Handler (Interrupt, Static); 1032 end Detach_Handler; 1033 1034 or 1035 accept Bind_Interrupt_To_Entry 1036 (T : Task_Id; 1037 E : Task_Entry_Index; 1038 Interrupt : Interrupt_ID) 1039 do 1040 -- if there is a binding already (either a procedure or an 1041 -- entry), raise Program_Error (propagate it to the caller). 1042 1043 if User_Handler (Interrupt).H /= null 1044 or else User_Entry (Interrupt).T /= Null_Task 1045 then 1046 raise Program_Error with 1047 "A binding for this interrupt is already present"; 1048 end if; 1049 1050 -- The interrupt should no longer be ignored if 1051 -- it was ever ignored. 1052 1053 Ignored (Interrupt) := False; 1054 User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E); 1055 1056 -- Indicate the attachment of Interrupt Entry in ATCB. 1057 -- This is need so that when an Interrupt Entry task 1058 -- terminates the binding can be cleaned. The call to 1059 -- unbinding must be made by the task before it terminates. 1060 1061 T.Interrupt_Entry := True; 1062 1063 -- Invoke a corresponding Server_Task if not yet created. 1064 -- Place Task_Id info in Server_ID array. 1065 1066 if Server_ID (Interrupt) = Null_Task then 1067 1068 -- When a new Server_Task is created, it should have its 1069 -- signal mask set to the All_Tasks_Mask. 1070 1071 IMOP.Set_Interrupt_Mask 1072 (IMOP.All_Tasks_Mask'Access, Old_Mask'Access); 1073 Access_Hold := new Server_Task (Interrupt); 1074 IMOP.Set_Interrupt_Mask (Old_Mask'Access); 1075 Server_ID (Interrupt) := 1076 To_System (Access_Hold.all'Identity); 1077 end if; 1078 1079 Bind_Handler (Interrupt); 1080 end Bind_Interrupt_To_Entry; 1081 1082 or 1083 accept Detach_Interrupt_Entries (T : Task_Id) do 1084 for J in Interrupt_ID'Range loop 1085 if not Is_Reserved (J) then 1086 if User_Entry (J).T = T then 1087 1088 -- The interrupt should no longer be ignored if 1089 -- it was ever ignored. 1090 1091 Ignored (J) := False; 1092 User_Entry (J) := Entry_Assoc' 1093 (T => Null_Task, E => Null_Task_Entry); 1094 Unbind_Handler (J); 1095 end if; 1096 end if; 1097 end loop; 1098 1099 -- Indicate in ATCB that no Interrupt Entries are attached 1100 1101 T.Interrupt_Entry := False; 1102 end Detach_Interrupt_Entries; 1103 1104 or 1105 accept Block_Interrupt (Interrupt : Interrupt_ID) do 1106 if Blocked (Interrupt) then 1107 return; 1108 end if; 1109 1110 Blocked (Interrupt) := True; 1111 Last_Unblocker (Interrupt) := Null_Task; 1112 1113 -- Mask this task for the given Interrupt so that all tasks 1114 -- are masked for the Interrupt. 1115 1116 IMOP.Thread_Block_Interrupt (IMNG.Interrupt_ID (Interrupt)); 1117 1118 if User_Handler (Interrupt).H /= null 1119 or else User_Entry (Interrupt).T /= Null_Task 1120 then 1121 -- This is the case where the Server_Task is waiting 1122 -- on "sigwait." Wake it up by sending an 1123 -- Abort_Task_Interrupt so that the Server_Task 1124 -- waits on Cond. 1125 1126 POP.Abort_Task (Server_ID (Interrupt)); 1127 1128 -- Make sure corresponding Server_Task is out of its own 1129 -- sigwait state. 1130 1131 Ret_Interrupt := Interrupt_ID 1132 (IMOP.Interrupt_Wait (Intwait_Mask'Access)); 1133 pragma Assert 1134 (Ret_Interrupt = 1135 Interrupt_ID (IMNG.Abort_Task_Interrupt)); 1136 end if; 1137 end Block_Interrupt; 1138 1139 or 1140 accept Unblock_Interrupt (Interrupt : Interrupt_ID) do 1141 if not Blocked (Interrupt) then 1142 return; 1143 end if; 1144 1145 Blocked (Interrupt) := False; 1146 Last_Unblocker (Interrupt) := 1147 To_System (Unblock_Interrupt'Caller); 1148 1149 if User_Handler (Interrupt).H = null 1150 and then User_Entry (Interrupt).T = Null_Task 1151 then 1152 -- No handler is attached. Unmask the Interrupt so that 1153 -- the default action can be carried out. 1154 1155 IMOP.Thread_Unblock_Interrupt 1156 (IMNG.Interrupt_ID (Interrupt)); 1157 1158 else 1159 -- The Server_Task must be waiting on the Cond variable 1160 -- since it was being blocked and an Interrupt Hander or 1161 -- an Entry was there. Wake it up and let it change 1162 -- it place of waiting according to its new state. 1163 1164 POP.Wakeup (Server_ID (Interrupt), 1165 Interrupt_Server_Blocked_Interrupt_Sleep); 1166 end if; 1167 end Unblock_Interrupt; 1168 1169 or 1170 accept Ignore_Interrupt (Interrupt : Interrupt_ID) do 1171 if Ignored (Interrupt) then 1172 return; 1173 end if; 1174 1175 Ignored (Interrupt) := True; 1176 1177 -- If there is a handler associated with the Interrupt, 1178 -- detach it first. In this way we make sure that the 1179 -- Server_Task is not on sigwait. This is legal since 1180 -- Unignore_Interrupt is to install the default action. 1181 1182 if User_Handler (Interrupt).H /= null then 1183 Unprotected_Detach_Handler 1184 (Interrupt => Interrupt, Static => True); 1185 1186 elsif User_Entry (Interrupt).T /= Null_Task then 1187 User_Entry (Interrupt) := Entry_Assoc' 1188 (T => Null_Task, E => Null_Task_Entry); 1189 Unbind_Handler (Interrupt); 1190 end if; 1191 1192 IMOP.Install_Ignore_Action (IMNG.Interrupt_ID (Interrupt)); 1193 end Ignore_Interrupt; 1194 1195 or 1196 accept Unignore_Interrupt (Interrupt : Interrupt_ID) do 1197 Ignored (Interrupt) := False; 1198 1199 -- If there is a handler associated with the Interrupt, 1200 -- detach it first. In this way we make sure that the 1201 -- Server_Task is not on sigwait. This is legal since 1202 -- Unignore_Interrupt is to install the default action. 1203 1204 if User_Handler (Interrupt).H /= null then 1205 Unprotected_Detach_Handler 1206 (Interrupt => Interrupt, Static => True); 1207 1208 elsif User_Entry (Interrupt).T /= Null_Task then 1209 User_Entry (Interrupt) := Entry_Assoc' 1210 (T => Null_Task, E => Null_Task_Entry); 1211 Unbind_Handler (Interrupt); 1212 end if; 1213 1214 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt)); 1215 end Unignore_Interrupt; 1216 end select; 1217 1218 exception 1219 -- If there is a program error we just want to propagate it to 1220 -- the caller and do not want to stop this task. 1221 1222 when Program_Error => 1223 null; 1224 1225 when others => 1226 pragma Assert (False); 1227 null; 1228 end; 1229 end loop; 1230 end Interrupt_Manager; 1231 1232 ----------------- 1233 -- Server_Task -- 1234 ----------------- 1235 1236 task body Server_Task is 1237 Intwait_Mask : aliased IMNG.Interrupt_Mask; 1238 Ret_Interrupt : Interrupt_ID; 1239 Self_ID : constant Task_Id := Self; 1240 Tmp_Handler : Parameterless_Handler; 1241 Tmp_ID : Task_Id; 1242 Tmp_Entry_Index : Task_Entry_Index; 1243 1244 begin 1245 -- By making this task independent of master, when the process 1246 -- goes away, the Server_Task will terminate gracefully. 1247 1248 System.Tasking.Utilities.Make_Independent; 1249 1250 -- Install default action in system level 1251 1252 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt)); 1253 1254 -- Note: All tasks in RTS will have all the Reserve Interrupts being 1255 -- masked (except the Interrupt_Manager) and Keep_Unmasked unmasked when 1256 -- created. 1257 1258 -- Abort_Task_Interrupt is one of the Interrupt unmasked in all tasks. 1259 -- We mask the Interrupt in this particular task so that "sigwait" is 1260 -- possible to catch an explicitly sent Abort_Task_Interrupt from the 1261 -- Interrupt_Manager. 1262 1263 -- There are two Interrupt interrupts that this task catch through 1264 -- "sigwait." One is the Interrupt this task is designated to catch 1265 -- in order to execute user handler or entry. The other one is the 1266 -- Abort_Task_Interrupt. This interrupt is being sent from the 1267 -- Interrupt_Manager to inform status changes (e.g: become Blocked, 1268 -- Handler or Entry is to be detached). 1269 1270 -- Prepare a mask to used for sigwait 1271 1272 IMOP.Empty_Interrupt_Mask (Intwait_Mask'Access); 1273 1274 IMOP.Add_To_Interrupt_Mask 1275 (Intwait_Mask'Access, IMNG.Interrupt_ID (Interrupt)); 1276 1277 IMOP.Add_To_Interrupt_Mask 1278 (Intwait_Mask'Access, IMNG.Abort_Task_Interrupt); 1279 1280 IMOP.Thread_Block_Interrupt 1281 (IMNG.Abort_Task_Interrupt); 1282 1283 PIO.Set_Interrupt_ID (IMNG.Interrupt_ID (Interrupt), Self_ID); 1284 1285 loop 1286 System.Tasking.Initialization.Defer_Abort (Self_ID); 1287 1288 if Single_Lock then 1289 POP.Lock_RTS; 1290 end if; 1291 1292 POP.Write_Lock (Self_ID); 1293 1294 if User_Handler (Interrupt).H = null 1295 and then User_Entry (Interrupt).T = Null_Task 1296 then 1297 -- No Interrupt binding. If there is an interrupt, 1298 -- Interrupt_Manager will take default action. 1299 1300 Self_ID.Common.State := Interrupt_Server_Blocked_Interrupt_Sleep; 1301 POP.Sleep (Self_ID, Interrupt_Server_Idle_Sleep); 1302 Self_ID.Common.State := Runnable; 1303 1304 elsif Blocked (Interrupt) then 1305 1306 -- Interrupt is blocked. Stay here, so we won't catch 1307 -- the Interrupt. 1308 1309 Self_ID.Common.State := Interrupt_Server_Blocked_Interrupt_Sleep; 1310 POP.Sleep (Self_ID, Interrupt_Server_Blocked_Interrupt_Sleep); 1311 Self_ID.Common.State := Runnable; 1312 1313 else 1314 -- A Handler or an Entry is installed. At this point all tasks 1315 -- mask for the Interrupt is masked. Catch the Interrupt using 1316 -- sigwait. 1317 1318 -- This task may wake up from sigwait by receiving an interrupt 1319 -- (Abort_Task_Interrupt) from the Interrupt_Manager for unbinding 1320 -- a Procedure Handler or an Entry. Or it could be a wake up 1321 -- from status change (Unblocked -> Blocked). If that is not 1322 -- the case, we should execute the attached Procedure or Entry. 1323 1324 Self_ID.Common.State := Interrupt_Server_Blocked_On_Event_Flag; 1325 POP.Unlock (Self_ID); 1326 1327 if Single_Lock then 1328 POP.Unlock_RTS; 1329 end if; 1330 1331 -- Avoid race condition when terminating application and 1332 -- System.Parameters.No_Abort is True. 1333 1334 if Parameters.No_Abort and then Self_ID.Pending_Action then 1335 Initialization.Do_Pending_Action (Self_ID); 1336 end if; 1337 1338 Ret_Interrupt := 1339 Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access)); 1340 Self_ID.Common.State := Runnable; 1341 1342 if Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt) then 1343 1344 -- Inform the Interrupt_Manager of wakeup from above sigwait 1345 1346 POP.Abort_Task (Interrupt_Manager_ID); 1347 1348 if Single_Lock then 1349 POP.Lock_RTS; 1350 end if; 1351 1352 POP.Write_Lock (Self_ID); 1353 1354 else 1355 if Single_Lock then 1356 POP.Lock_RTS; 1357 end if; 1358 1359 POP.Write_Lock (Self_ID); 1360 1361 if Ret_Interrupt /= Interrupt then 1362 1363 -- On some systems (e.g. recent linux kernels), sigwait 1364 -- may return unexpectedly (with errno set to EINTR). 1365 1366 null; 1367 1368 else 1369 -- Even though we have received an Interrupt the status may 1370 -- have changed already before we got the Self_ID lock above 1371 -- Therefore we make sure a Handler or an Entry is still 1372 -- there and make appropriate call. 1373 1374 -- If there is no calls to make we need to regenerate the 1375 -- Interrupt in order not to lose it. 1376 1377 if User_Handler (Interrupt).H /= null then 1378 Tmp_Handler := User_Handler (Interrupt).H; 1379 1380 -- RTS calls should not be made with self being locked 1381 1382 POP.Unlock (Self_ID); 1383 1384 if Single_Lock then 1385 POP.Unlock_RTS; 1386 end if; 1387 1388 Tmp_Handler.all; 1389 1390 if Single_Lock then 1391 POP.Lock_RTS; 1392 end if; 1393 1394 POP.Write_Lock (Self_ID); 1395 1396 elsif User_Entry (Interrupt).T /= Null_Task then 1397 Tmp_ID := User_Entry (Interrupt).T; 1398 Tmp_Entry_Index := User_Entry (Interrupt).E; 1399 1400 -- RTS calls should not be made with self being locked 1401 1402 if Single_Lock then 1403 POP.Unlock_RTS; 1404 end if; 1405 1406 POP.Unlock (Self_ID); 1407 1408 System.Tasking.Rendezvous.Call_Simple 1409 (Tmp_ID, Tmp_Entry_Index, System.Null_Address); 1410 1411 POP.Write_Lock (Self_ID); 1412 1413 if Single_Lock then 1414 POP.Lock_RTS; 1415 end if; 1416 1417 else 1418 -- This is a situation that this task wakes up receiving 1419 -- an Interrupt and before it gets the lock the Interrupt 1420 -- is blocked. We do not want to lose the interrupt in 1421 -- this case so we regenerate the Interrupt to process 1422 -- level. 1423 1424 IMOP.Interrupt_Self_Process 1425 (IMNG.Interrupt_ID (Interrupt)); 1426 end if; 1427 end if; 1428 end if; 1429 end if; 1430 1431 POP.Unlock (Self_ID); 1432 1433 if Single_Lock then 1434 POP.Unlock_RTS; 1435 end if; 1436 1437 System.Tasking.Initialization.Undefer_Abort (Self_ID); 1438 1439 if Self_ID.Pending_Action then 1440 Initialization.Do_Pending_Action (Self_ID); 1441 end if; 1442 1443 -- Undefer abort here to allow a window for this task to be aborted 1444 -- at the time of system shutdown. We also explicitly test for 1445 -- Pending_Action in case System.Parameters.No_Abort is True. 1446 1447 end loop; 1448 end Server_Task; 1449 1450-- Elaboration code for package System.Interrupts 1451 1452begin 1453 -- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent 1454 1455 Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity); 1456 1457 -- During the elaboration of this package body we want the RTS 1458 -- to inherit the interrupt mask from the Environment Task. 1459 1460 IMOP.Setup_Interrupt_Mask; 1461 1462 -- The environment task should have gotten its mask from the enclosing 1463 -- process during the RTS start up. (See processing in s-inmaop.adb). Pass 1464 -- the Interrupt_Mask of the environment task to the Interrupt_Manager. 1465 1466 -- Note: At this point we know that all tasks are masked for non-reserved 1467 -- signals. Only the Interrupt_Manager will have masks set up differently 1468 -- inheriting the original environment task's mask. 1469 1470 Interrupt_Manager.Initialize (IMOP.Environment_Mask); 1471end System.Interrupts; 1472