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