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