1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- 4-- -- 5-- S Y S T E M . T A S K I N G . R E S T R I C T E D . S T A G E S -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1999-2012, 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 32pragma Style_Checks (All_Checks); 33-- Turn off subprogram alpha order check, since we group soft link 34-- bodies and also separate off subprograms for restricted GNARLI. 35 36-- This is a simplified version of the System.Tasking.Stages package, 37-- intended to be used in a restricted run time. 38 39-- This package represents the high level tasking interface used by the 40-- compiler to expand Ada 95 tasking constructs into simpler run time calls. 41 42pragma Polling (Off); 43-- Turn off polling, we do not want ATC polling to take place during 44-- tasking operations. It causes infinite loops and other problems. 45 46with Ada.Exceptions; 47 48with System.Task_Primitives.Operations; 49with System.Soft_Links.Tasking; 50with System.Secondary_Stack; 51with System.Storage_Elements; 52 53with System.Soft_Links; 54-- Used for the non-tasking routines (*_NT) that refer to global data. They 55-- are needed here before the tasking run time has been elaborated. used for 56-- Create_TSD This package also provides initialization routines for task 57-- specific data. The GNARL must call these to be sure that all non-tasking 58-- Ada constructs will work. 59 60package body System.Tasking.Restricted.Stages is 61 62 package STPO renames System.Task_Primitives.Operations; 63 package SSL renames System.Soft_Links; 64 package SSE renames System.Storage_Elements; 65 package SST renames System.Secondary_Stack; 66 67 use Ada.Exceptions; 68 69 use Parameters; 70 use Task_Primitives.Operations; 71 use Task_Info; 72 73 Tasks_Activation_Chain : Task_Id; 74 -- Chain of all the tasks to activate 75 76 Global_Task_Lock : aliased System.Task_Primitives.RTS_Lock; 77 -- This is a global lock; it is used to execute in mutual exclusion 78 -- from all other tasks. It is only used by Task_Lock and Task_Unlock. 79 80 ----------------------------------------------------------------- 81 -- Tasking versions of services needed by non-tasking programs -- 82 ----------------------------------------------------------------- 83 84 function Get_Current_Excep return SSL.EOA; 85 -- Task-safe version of SSL.Get_Current_Excep 86 87 procedure Task_Lock; 88 -- Locks out other tasks. Preceding a section of code by Task_Lock and 89 -- following it by Task_Unlock creates a critical region. This is used 90 -- for ensuring that a region of non-tasking code (such as code used to 91 -- allocate memory) is tasking safe. Note that it is valid for calls to 92 -- Task_Lock/Task_Unlock to be nested, and this must work properly, i.e. 93 -- only the corresponding outer level Task_Unlock will actually unlock. 94 95 procedure Task_Unlock; 96 -- Releases lock previously set by call to Task_Lock. In the nested case, 97 -- all nested locks must be released before other tasks competing for the 98 -- tasking lock are released. 99 100 ----------------------- 101 -- Local Subprograms -- 102 ----------------------- 103 104 procedure Task_Wrapper (Self_ID : Task_Id); 105 -- This is the procedure that is called by the GNULL from the 106 -- new context when a task is created. It waits for activation 107 -- and then calls the task body procedure. When the task body 108 -- procedure completes, it terminates the task. 109 110 procedure Terminate_Task (Self_ID : Task_Id); 111 -- Terminate the calling task. 112 -- This should only be called by the Task_Wrapper procedure. 113 114 procedure Create_Restricted_Task 115 (Priority : Integer; 116 Stack_Address : System.Address; 117 Size : System.Parameters.Size_Type; 118 Task_Info : System.Task_Info.Task_Info_Type; 119 CPU : Integer; 120 State : Task_Procedure_Access; 121 Discriminants : System.Address; 122 Elaborated : Access_Boolean; 123 Task_Image : String; 124 Created_Task : Task_Id); 125 -- Code shared between Create_Restricted_Task_Concurrent and 126 -- Create_Restricted_Task_Sequential. See comment of the former in the 127 -- specification of this package. 128 129 procedure Activate_Tasks (Chain : Task_Id); 130 -- Activate the list of tasks started by Chain 131 132 procedure Init_RTS; 133 -- This procedure performs the initialization of the GNARL. 134 -- It consists of initializing the environment task, global locks, and 135 -- installing tasking versions of certain operations used by the compiler. 136 -- Init_RTS is called during elaboration. 137 138 ----------------------- 139 -- Get_Current_Excep -- 140 ----------------------- 141 142 function Get_Current_Excep return SSL.EOA is 143 begin 144 return STPO.Self.Common.Compiler_Data.Current_Excep'Access; 145 end Get_Current_Excep; 146 147 --------------- 148 -- Task_Lock -- 149 --------------- 150 151 procedure Task_Lock is 152 Self_ID : constant Task_Id := STPO.Self; 153 154 begin 155 Self_ID.Common.Global_Task_Lock_Nesting := 156 Self_ID.Common.Global_Task_Lock_Nesting + 1; 157 158 if Self_ID.Common.Global_Task_Lock_Nesting = 1 then 159 STPO.Write_Lock (Global_Task_Lock'Access, Global_Lock => True); 160 end if; 161 end Task_Lock; 162 163 ----------------- 164 -- Task_Unlock -- 165 ----------------- 166 167 procedure Task_Unlock is 168 Self_ID : constant Task_Id := STPO.Self; 169 170 begin 171 pragma Assert (Self_ID.Common.Global_Task_Lock_Nesting > 0); 172 Self_ID.Common.Global_Task_Lock_Nesting := 173 Self_ID.Common.Global_Task_Lock_Nesting - 1; 174 175 if Self_ID.Common.Global_Task_Lock_Nesting = 0 then 176 STPO.Unlock (Global_Task_Lock'Access, Global_Lock => True); 177 end if; 178 end Task_Unlock; 179 180 ------------------ 181 -- Task_Wrapper -- 182 ------------------ 183 184 -- The task wrapper is a procedure that is called first for each task 185 -- task body, and which in turn calls the compiler-generated task body 186 -- procedure. The wrapper's main job is to do initialization for the task. 187 188 -- The variable ID in the task wrapper is used to implement the Self 189 -- function on targets where there is a fast way to find the stack base 190 -- of the current thread, since it should be at a fixed offset from the 191 -- stack base. 192 193 procedure Task_Wrapper (Self_ID : Task_Id) is 194 ID : Task_Id := Self_ID; 195 pragma Volatile (ID); 196 pragma Warnings (Off, ID); 197 -- Variable used on some targets to implement a fast self. We turn off 198 -- warnings because a stand alone volatile constant has to be imported, 199 -- so we don't want warnings about ID not being referenced, and volatile 200 -- having no effect. 201 -- 202 -- DO NOT delete ID. As noted, it is needed on some targets. 203 204 use type SSE.Storage_Offset; 205 206 Secondary_Stack : aliased SSE.Storage_Array 207 (1 .. Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size * 208 SSE.Storage_Offset (Parameters.Sec_Stack_Percentage) / 100); 209 210 pragma Warnings (Off); 211 Secondary_Stack_Address : System.Address := Secondary_Stack'Address; 212 pragma Warnings (On); 213 -- Address of secondary stack. In the fixed secondary stack case, this 214 -- value is not modified, causing a warning, hence the bracketing with 215 -- Warnings (Off/On). 216 217 Cause : Cause_Of_Termination := Normal; 218 -- Indicates the reason why this task terminates. Normal corresponds to 219 -- a task terminating due to completing the last statement of its body. 220 -- If the task terminates because of an exception raised by the 221 -- execution of its task body, then Cause is set to Unhandled_Exception. 222 -- Aborts are not allowed in the restricted profile to which this file 223 -- belongs. 224 225 EO : Exception_Occurrence; 226 -- If the task terminates because of an exception raised by the 227 -- execution of its task body, then EO will contain the associated 228 -- exception occurrence. Otherwise, it will contain Null_Occurrence. 229 230 begin 231 if not Parameters.Sec_Stack_Dynamic then 232 Self_ID.Common.Compiler_Data.Sec_Stack_Addr := 233 Secondary_Stack'Address; 234 SST.SS_Init (Secondary_Stack_Address, Integer (Secondary_Stack'Last)); 235 end if; 236 237 -- Initialize low-level TCB components, that 238 -- cannot be initialized by the creator. 239 240 Enter_Task (Self_ID); 241 242 -- Call the task body procedure 243 244 begin 245 -- We are separating the following portion of the code in order to 246 -- place the exception handlers in a different block. In this way we 247 -- do not call Set_Jmpbuf_Address (which needs Self) before we set 248 -- Self in Enter_Task. 249 250 -- Note that in the case of Ravenscar HI-E where there are no 251 -- exception handlers, the exception handler is suppressed. 252 253 -- Call the task body procedure 254 255 Self_ID.Common.Task_Entry_Point (Self_ID.Common.Task_Arg); 256 257 -- Normal task termination 258 259 Cause := Normal; 260 Save_Occurrence (EO, Ada.Exceptions.Null_Occurrence); 261 262 exception 263 when E : others => 264 265 -- Task terminating because of an unhandled exception 266 267 Cause := Unhandled_Exception; 268 Save_Occurrence (EO, E); 269 end; 270 271 -- Look for a fall-back handler. It can be either in the task itself 272 -- or in the environment task. Note that this code is always executed 273 -- by a task whose master is the environment task. The task termination 274 -- code for the environment task is executed by 275 -- SSL.Task_Termination_Handler. 276 277 -- This package is part of the restricted run time which supports 278 -- neither task hierarchies (No_Task_Hierarchy) nor specific task 279 -- termination handlers (No_Specific_Termination_Handlers). 280 281 -- There is no need for explicit protection against race conditions 282 -- for Self_ID.Common.Fall_Back_Handler because this procedure can 283 -- only be executed by Self, and the Fall_Back_Handler can only be 284 -- modified by Self. 285 286 if Self_ID.Common.Fall_Back_Handler /= null then 287 Self_ID.Common.Fall_Back_Handler (Cause, Self_ID, EO); 288 else 289 declare 290 TH : Termination_Handler := null; 291 292 begin 293 if Single_Lock then 294 Lock_RTS; 295 end if; 296 297 Write_Lock (Self_ID.Common.Parent); 298 299 TH := Self_ID.Common.Parent.Common.Fall_Back_Handler; 300 301 Unlock (Self_ID.Common.Parent); 302 303 if Single_Lock then 304 Unlock_RTS; 305 end if; 306 307 -- Execute the task termination handler if we found it 308 309 if TH /= null then 310 TH.all (Cause, Self_ID, EO); 311 end if; 312 end; 313 end if; 314 315 Terminate_Task (Self_ID); 316 end Task_Wrapper; 317 318 ----------------------- 319 -- Restricted GNARLI -- 320 ----------------------- 321 322 ----------------------------------- 323 -- Activate_All_Tasks_Sequential -- 324 ----------------------------------- 325 326 procedure Activate_All_Tasks_Sequential is 327 begin 328 pragma Assert (Partition_Elaboration_Policy = 'S'); 329 330 Activate_Tasks (Tasks_Activation_Chain); 331 Tasks_Activation_Chain := Null_Task; 332 end Activate_All_Tasks_Sequential; 333 334 ------------------------------- 335 -- Activate_Restricted_Tasks -- 336 ------------------------------- 337 338 procedure Activate_Restricted_Tasks 339 (Chain_Access : Activation_Chain_Access) is 340 begin 341 if Partition_Elaboration_Policy = 'S' then 342 343 -- In sequential elaboration policy, the chain must be empty. This 344 -- procedure can be called if the unit has been compiled without 345 -- partition elaboration policy, but the partition has a sequential 346 -- elaboration policy. 347 348 pragma Assert (Chain_Access.T_ID = Null_Task); 349 null; 350 else 351 Activate_Tasks (Chain_Access.T_ID); 352 Chain_Access.T_ID := Null_Task; 353 end if; 354 end Activate_Restricted_Tasks; 355 356 -------------------- 357 -- Activate_Tasks -- 358 -------------------- 359 360 -- Note that locks of activator and activated task are both locked here. 361 -- This is necessary because C.State and Self.Wait_Count have to be 362 -- synchronized. This is safe from deadlock because the activator is always 363 -- created before the activated task. That satisfies our 364 -- in-order-of-creation ATCB locking policy. 365 366 procedure Activate_Tasks (Chain : Task_Id) is 367 Self_ID : constant Task_Id := STPO.Self; 368 C : Task_Id; 369 Activate_Prio : System.Any_Priority; 370 Success : Boolean; 371 372 begin 373 pragma Assert (Self_ID = Environment_Task); 374 pragma Assert (Self_ID.Common.Wait_Count = 0); 375 376 if Single_Lock then 377 Lock_RTS; 378 end if; 379 380 -- Lock self, to prevent activated tasks from racing ahead before we 381 -- finish activating the chain. 382 383 Write_Lock (Self_ID); 384 385 -- Activate all the tasks in the chain. Creation of the thread of 386 -- control was deferred until activation. So create it now. 387 388 C := Chain; 389 while C /= null loop 390 if C.Common.State /= Terminated then 391 pragma Assert (C.Common.State = Unactivated); 392 393 Write_Lock (C); 394 395 Activate_Prio := 396 (if C.Common.Base_Priority < Get_Priority (Self_ID) 397 then Get_Priority (Self_ID) 398 else C.Common.Base_Priority); 399 400 STPO.Create_Task 401 (C, Task_Wrapper'Address, 402 Parameters.Size_Type 403 (C.Common.Compiler_Data.Pri_Stack_Info.Size), 404 Activate_Prio, Success); 405 406 Self_ID.Common.Wait_Count := Self_ID.Common.Wait_Count + 1; 407 408 if Success then 409 C.Common.State := Runnable; 410 else 411 raise Program_Error; 412 end if; 413 414 Unlock (C); 415 end if; 416 417 C := C.Common.Activation_Link; 418 end loop; 419 420 Self_ID.Common.State := Activator_Sleep; 421 422 -- Wait for the activated tasks to complete activation. It is unsafe to 423 -- abort any of these tasks until the count goes to zero. 424 425 loop 426 exit when Self_ID.Common.Wait_Count = 0; 427 Sleep (Self_ID, Activator_Sleep); 428 end loop; 429 430 Self_ID.Common.State := Runnable; 431 Unlock (Self_ID); 432 433 if Single_Lock then 434 Unlock_RTS; 435 end if; 436 end Activate_Tasks; 437 438 ------------------------------------ 439 -- Complete_Restricted_Activation -- 440 ------------------------------------ 441 442 -- As in several other places, the locks of the activator and activated 443 -- task are both locked here. This follows our deadlock prevention lock 444 -- ordering policy, since the activated task must be created after the 445 -- activator. 446 447 procedure Complete_Restricted_Activation is 448 Self_ID : constant Task_Id := STPO.Self; 449 Activator : constant Task_Id := Self_ID.Common.Activator; 450 451 begin 452 if Single_Lock then 453 Lock_RTS; 454 end if; 455 456 Write_Lock (Activator); 457 Write_Lock (Self_ID); 458 459 -- Remove dangling reference to Activator, since a task may outlive its 460 -- activator. 461 462 Self_ID.Common.Activator := null; 463 464 -- Wake up the activator, if it is waiting for a chain of tasks to 465 -- activate, and we are the last in the chain to complete activation 466 467 if Activator.Common.State = Activator_Sleep then 468 Activator.Common.Wait_Count := Activator.Common.Wait_Count - 1; 469 470 if Activator.Common.Wait_Count = 0 then 471 Wakeup (Activator, Activator_Sleep); 472 end if; 473 end if; 474 475 Unlock (Self_ID); 476 Unlock (Activator); 477 478 if Single_Lock then 479 Unlock_RTS; 480 end if; 481 482 -- After the activation, active priority should be the same as base 483 -- priority. We must unlock the Activator first, though, since it should 484 -- not wait if we have lower priority. 485 486 if Get_Priority (Self_ID) /= Self_ID.Common.Base_Priority then 487 Set_Priority (Self_ID, Self_ID.Common.Base_Priority); 488 end if; 489 end Complete_Restricted_Activation; 490 491 ------------------------------ 492 -- Complete_Restricted_Task -- 493 ------------------------------ 494 495 procedure Complete_Restricted_Task is 496 begin 497 STPO.Self.Common.State := Terminated; 498 end Complete_Restricted_Task; 499 500 ---------------------------- 501 -- Create_Restricted_Task -- 502 ---------------------------- 503 504 procedure Create_Restricted_Task 505 (Priority : Integer; 506 Stack_Address : System.Address; 507 Size : System.Parameters.Size_Type; 508 Task_Info : System.Task_Info.Task_Info_Type; 509 CPU : Integer; 510 State : Task_Procedure_Access; 511 Discriminants : System.Address; 512 Elaborated : Access_Boolean; 513 Task_Image : String; 514 Created_Task : Task_Id) 515 is 516 Self_ID : constant Task_Id := STPO.Self; 517 Base_Priority : System.Any_Priority; 518 Base_CPU : System.Multiprocessors.CPU_Range; 519 Success : Boolean; 520 Len : Integer; 521 522 begin 523 -- Stack is not preallocated on this target, so that Stack_Address must 524 -- be null. 525 526 pragma Assert (Stack_Address = Null_Address); 527 528 Base_Priority := 529 (if Priority = Unspecified_Priority 530 then Self_ID.Common.Base_Priority 531 else System.Any_Priority (Priority)); 532 533 -- Legal values of CPU are the special Unspecified_CPU value which is 534 -- inserted by the compiler for tasks without CPU aspect, and those in 535 -- the range of CPU_Range but no greater than Number_Of_CPUs. Otherwise 536 -- the task is defined to have failed, and it becomes a completed task 537 -- (RM D.16(14/3)). 538 539 if CPU /= Unspecified_CPU 540 and then (CPU < Integer (System.Multiprocessors.CPU_Range'First) 541 or else CPU > Integer (System.Multiprocessors.CPU_Range'Last) 542 or else CPU > Integer (System.Multiprocessors.Number_Of_CPUs)) 543 then 544 raise Tasking_Error with "CPU not in range"; 545 546 -- Normal CPU affinity 547 else 548 -- When the application code says nothing about the task affinity 549 -- (task without CPU aspect) then the compiler inserts the 550 -- Unspecified_CPU value which indicates to the run-time library that 551 -- the task will activate and execute on the same processor as its 552 -- activating task if the activating task is assigned a processor 553 -- (RM D.16(14/3)). 554 555 Base_CPU := 556 (if CPU = Unspecified_CPU 557 then Self_ID.Common.Base_CPU 558 else System.Multiprocessors.CPU_Range (CPU)); 559 end if; 560 561 if Single_Lock then 562 Lock_RTS; 563 end if; 564 565 Write_Lock (Self_ID); 566 567 -- With no task hierarchy, the parent of all non-Environment tasks that 568 -- are created must be the Environment task. Dispatching domains are 569 -- not allowed in Ravenscar, so the dispatching domain parameter will 570 -- always be null. 571 572 Initialize_ATCB 573 (Self_ID, State, Discriminants, Self_ID, Elaborated, Base_Priority, 574 Base_CPU, null, Task_Info, Size, Created_Task, Success); 575 576 -- If we do our job right then there should never be any failures, which 577 -- was probably said about the Titanic; so just to be safe, let's retain 578 -- this code for now 579 580 if not Success then 581 Unlock (Self_ID); 582 583 if Single_Lock then 584 Unlock_RTS; 585 end if; 586 587 raise Program_Error; 588 end if; 589 590 Created_Task.Entry_Calls (1).Self := Created_Task; 591 592 Len := 593 Integer'Min (Created_Task.Common.Task_Image'Length, Task_Image'Length); 594 Created_Task.Common.Task_Image_Len := Len; 595 Created_Task.Common.Task_Image (1 .. Len) := 596 Task_Image (Task_Image'First .. Task_Image'First + Len - 1); 597 598 Unlock (Self_ID); 599 600 if Single_Lock then 601 Unlock_RTS; 602 end if; 603 604 -- Create TSD as early as possible in the creation of a task, since it 605 -- may be used by the operation of Ada code within the task. 606 607 SSL.Create_TSD (Created_Task.Common.Compiler_Data); 608 end Create_Restricted_Task; 609 610 procedure Create_Restricted_Task 611 (Priority : Integer; 612 Stack_Address : System.Address; 613 Size : System.Parameters.Size_Type; 614 Task_Info : System.Task_Info.Task_Info_Type; 615 CPU : Integer; 616 State : Task_Procedure_Access; 617 Discriminants : System.Address; 618 Elaborated : Access_Boolean; 619 Chain : in out Activation_Chain; 620 Task_Image : String; 621 Created_Task : Task_Id) 622 is 623 begin 624 if Partition_Elaboration_Policy = 'S' then 625 626 -- A unit may have been compiled without partition elaboration 627 -- policy, and in this case the compiler will emit calls for the 628 -- default policy (concurrent). But if the partition policy is 629 -- sequential, activation must be deferred. 630 631 Create_Restricted_Task_Sequential 632 (Priority, Stack_Address, Size, Task_Info, CPU, State, 633 Discriminants, Elaborated, Task_Image, Created_Task); 634 635 else 636 Create_Restricted_Task 637 (Priority, Stack_Address, Size, Task_Info, CPU, State, 638 Discriminants, Elaborated, Task_Image, Created_Task); 639 640 -- Append this task to the activation chain 641 642 Created_Task.Common.Activation_Link := Chain.T_ID; 643 Chain.T_ID := Created_Task; 644 end if; 645 end Create_Restricted_Task; 646 647 --------------------------------------- 648 -- Create_Restricted_Task_Sequential -- 649 --------------------------------------- 650 651 procedure Create_Restricted_Task_Sequential 652 (Priority : Integer; 653 Stack_Address : System.Address; 654 Size : System.Parameters.Size_Type; 655 Task_Info : System.Task_Info.Task_Info_Type; 656 CPU : Integer; 657 State : Task_Procedure_Access; 658 Discriminants : System.Address; 659 Elaborated : Access_Boolean; 660 Task_Image : String; 661 Created_Task : Task_Id) is 662 begin 663 Create_Restricted_Task (Priority, Stack_Address, Size, Task_Info, 664 CPU, State, Discriminants, Elaborated, 665 Task_Image, Created_Task); 666 667 -- Append this task to the activation chain 668 669 Created_Task.Common.Activation_Link := Tasks_Activation_Chain; 670 Tasks_Activation_Chain := Created_Task; 671 end Create_Restricted_Task_Sequential; 672 673 --------------------------- 674 -- Finalize_Global_Tasks -- 675 --------------------------- 676 677 -- This is needed to support the compiler interface; it will only be called 678 -- by the Environment task. Instead, it will cause the Environment to block 679 -- forever, since none of the dependent tasks are expected to terminate 680 681 procedure Finalize_Global_Tasks is 682 Self_ID : constant Task_Id := STPO.Self; 683 684 begin 685 pragma Assert (Self_ID = STPO.Environment_Task); 686 687 if Single_Lock then 688 Lock_RTS; 689 end if; 690 691 -- Handle normal task termination by the environment task, but only for 692 -- the normal task termination. In the case of Abnormal and 693 -- Unhandled_Exception they must have been handled before, and the task 694 -- termination soft link must have been changed so the task termination 695 -- routine is not executed twice. 696 697 -- Note that in the "normal" implementation in s-tassta.adb the task 698 -- termination procedure for the environment task should be executed 699 -- after termination of library-level tasks. However, this 700 -- implementation is to be used when the Ravenscar restrictions are in 701 -- effect, and AI-394 says that if there is a fall-back handler set for 702 -- the partition it should be called when the first task (including the 703 -- environment task) attempts to terminate. 704 705 SSL.Task_Termination_Handler.all (Ada.Exceptions.Null_Occurrence); 706 707 Write_Lock (Self_ID); 708 Sleep (Self_ID, Master_Completion_Sleep); 709 Unlock (Self_ID); 710 711 if Single_Lock then 712 Unlock_RTS; 713 end if; 714 715 -- Should never return from Master Completion Sleep 716 717 raise Program_Error; 718 end Finalize_Global_Tasks; 719 720 --------------------------- 721 -- Restricted_Terminated -- 722 --------------------------- 723 724 function Restricted_Terminated (T : Task_Id) return Boolean is 725 begin 726 return T.Common.State = Terminated; 727 end Restricted_Terminated; 728 729 -------------------- 730 -- Terminate_Task -- 731 -------------------- 732 733 procedure Terminate_Task (Self_ID : Task_Id) is 734 begin 735 Self_ID.Common.State := Terminated; 736 end Terminate_Task; 737 738 -------------- 739 -- Init_RTS -- 740 -------------- 741 742 procedure Init_RTS is 743 begin 744 Tasking.Initialize; 745 746 -- Initialize lock used to implement mutual exclusion between all tasks 747 748 STPO.Initialize_Lock (Global_Task_Lock'Access, STPO.Global_Task_Level); 749 750 -- Notify that the tasking run time has been elaborated so that 751 -- the tasking version of the soft links can be used. 752 753 SSL.Lock_Task := Task_Lock'Access; 754 SSL.Unlock_Task := Task_Unlock'Access; 755 SSL.Adafinal := Finalize_Global_Tasks'Access; 756 SSL.Get_Current_Excep := Get_Current_Excep'Access; 757 758 -- Initialize the tasking soft links (if not done yet) that are common 759 -- to the full and the restricted run times. 760 761 SSL.Tasking.Init_Tasking_Soft_Links; 762 end Init_RTS; 763 764begin 765 Init_RTS; 766end System.Tasking.Restricted.Stages; 767