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