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