gcc/ada/s-tarest.adb

   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-2013, 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 pragma 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
  42 pragma 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
  46 with Ada.Exceptions;
  47
  48 with System.Task_Primitives.Operations;
  49 with System.Soft_Links.Tasking;
  50 with System.Secondary_Stack;
  51 with System.Storage_Elements;
  52
  53 with 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
  60 package 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
 272
 273       --  This package is part of the restricted run time which supports
 274       --  neither task hierarchies (No_Task_Hierarchy) nor specific task
 275       --  termination handlers (No_Specific_Termination_Handlers).
 276
 277       --  As specified in ARM C.7.3 par. 9/2, "the fall-back handler applies
 278       --  only to the dependent tasks of the task". Hence, if the terminating
 279       --  tasks (Self_ID) had a fall-back handler, it would not apply to
 280       --  itself. This code is always executed by a task whose master is the
 281       --  environment task (the task termination code for the environment task
 282       --  is executed by SSL.Task_Termination_Handler), so the fall-back
 283       --  handler to execute for this task can only be defined by its parent
 284       --  (there is no grandparent).
 285
 286       declare
 287          TH : Termination_Handler := null;
 288
 289       begin
 290          if Single_Lock then
 291             Lock_RTS;
 292          end if;
 293
 294          Write_Lock (Self_ID.Common.Parent);
 295
 296          TH := Self_ID.Common.Parent.Common.Fall_Back_Handler;
 297
 298          Unlock (Self_ID.Common.Parent);
 299
 300          if Single_Lock then
 301             Unlock_RTS;
 302          end if;
 303
 304          --  Execute the task termination handler if we found it
 305
 306          if TH /= null then
 307             TH.all (Cause, Self_ID, EO);
 308          end if;
 309       end;
 310
 311       Terminate_Task (Self_ID);
 312    end Task_Wrapper;
 313
 314    -----------------------
 315    -- Restricted GNARLI --
 316    -----------------------
 317
 318    -----------------------------------
 319    -- Activate_All_Tasks_Sequential --
 320    -----------------------------------
 321
 322    procedure Activate_All_Tasks_Sequential is
 323    begin
 324       pragma Assert (Partition_Elaboration_Policy = 'S');
 325
 326       Activate_Tasks (Tasks_Activation_Chain);
 327       Tasks_Activation_Chain := Null_Task;
 328    end Activate_All_Tasks_Sequential;
 329
 330    -------------------------------
 331    -- Activate_Restricted_Tasks --
 332    -------------------------------
 333
 334    procedure Activate_Restricted_Tasks
 335      (Chain_Access : Activation_Chain_Access) is
 336    begin
 337       if Partition_Elaboration_Policy = 'S' then
 338
 339          --  In sequential elaboration policy, the chain must be empty. This
 340          --  procedure can be called if the unit has been compiled without
 341          --  partition elaboration policy, but the partition has a sequential
 342          --  elaboration policy.
 343
 344          pragma Assert (Chain_Access.T_ID = Null_Task);
 345          null;
 346       else
 347          Activate_Tasks (Chain_Access.T_ID);
 348          Chain_Access.T_ID := Null_Task;
 349       end if;
 350    end Activate_Restricted_Tasks;
 351
 352    --------------------
 353    -- Activate_Tasks --
 354    --------------------
 355
 356    --  Note that locks of activator and activated task are both locked here.
 357    --  This is necessary because C.State and Self.Wait_Count have to be
 358    --  synchronized. This is safe from deadlock because the activator is always
 359    --  created before the activated task. That satisfies our
 360    --  in-order-of-creation ATCB locking policy.
 361
 362    procedure Activate_Tasks (Chain : Task_Id) is
 363       Self_ID       : constant Task_Id := STPO.Self;
 364       C             : Task_Id;
 365       Activate_Prio : System.Any_Priority;
 366       Success       : Boolean;
 367
 368    begin
 369       pragma Assert (Self_ID = Environment_Task);
 370       pragma Assert (Self_ID.Common.Wait_Count = 0);
 371
 372       if Single_Lock then
 373          Lock_RTS;
 374       end if;
 375
 376       --  Lock self, to prevent activated tasks from racing ahead before we
 377       --  finish activating the chain.
 378
 379       Write_Lock (Self_ID);
 380
 381       --  Activate all the tasks in the chain. Creation of the thread of
 382       --  control was deferred until activation. So create it now.
 383
 384       C := Chain;
 385       while C /= null loop
 386          if C.Common.State /= Terminated then
 387             pragma Assert (C.Common.State = Unactivated);
 388
 389             Write_Lock (C);
 390
 391             Activate_Prio :=
 392               (if C.Common.Base_Priority < Get_Priority (Self_ID)
 393                then Get_Priority (Self_ID)
 394                else C.Common.Base_Priority);
 395
 396             STPO.Create_Task
 397               (C, Task_Wrapper'Address,
 398                Parameters.Size_Type
 399                  (C.Common.Compiler_Data.Pri_Stack_Info.Size),
 400                Activate_Prio, Success);
 401
 402             Self_ID.Common.Wait_Count := Self_ID.Common.Wait_Count + 1;
 403
 404             if Success then
 405                C.Common.State := Runnable;
 406             else
 407                raise Program_Error;
 408             end if;
 409
 410             Unlock (C);
 411          end if;
 412
 413          C := C.Common.Activation_Link;
 414       end loop;
 415
 416       Self_ID.Common.State := Activator_Sleep;
 417
 418       --  Wait for the activated tasks to complete activation. It is unsafe to
 419       --  abort any of these tasks until the count goes to zero.
 420
 421       loop
 422          exit when Self_ID.Common.Wait_Count = 0;
 423          Sleep (Self_ID, Activator_Sleep);
 424       end loop;
 425
 426       Self_ID.Common.State := Runnable;
 427       Unlock (Self_ID);
 428
 429       if Single_Lock then
 430          Unlock_RTS;
 431       end if;
 432    end Activate_Tasks;
 433
 434    ------------------------------------
 435    -- Complete_Restricted_Activation --
 436    ------------------------------------
 437
 438    --  As in several other places, the locks of the activator and activated
 439    --  task are both locked here. This follows our deadlock prevention lock
 440    --  ordering policy, since the activated task must be created after the
 441    --  activator.
 442
 443    procedure Complete_Restricted_Activation is
 444       Self_ID   : constant Task_Id := STPO.Self;
 445       Activator : constant Task_Id := Self_ID.Common.Activator;
 446
 447    begin
 448       if Single_Lock then
 449          Lock_RTS;
 450       end if;
 451
 452       Write_Lock (Activator);
 453       Write_Lock (Self_ID);
 454
 455       --  Remove dangling reference to Activator, since a task may outlive its
 456       --  activator.
 457
 458       Self_ID.Common.Activator := null;
 459
 460       --  Wake up the activator, if it is waiting for a chain of tasks to
 461       --  activate, and we are the last in the chain to complete activation
 462
 463       if Activator.Common.State = Activator_Sleep then
 464          Activator.Common.Wait_Count := Activator.Common.Wait_Count - 1;
 465
 466          if Activator.Common.Wait_Count = 0 then
 467             Wakeup (Activator, Activator_Sleep);
 468          end if;
 469       end if;
 470
 471       Unlock (Self_ID);
 472       Unlock (Activator);
 473
 474       if Single_Lock then
 475          Unlock_RTS;
 476       end if;
 477
 478       --  After the activation, active priority should be the same as base
 479       --  priority. We must unlock the Activator first, though, since it should
 480       --  not wait if we have lower priority.
 481
 482       if Get_Priority (Self_ID) /= Self_ID.Common.Base_Priority then
 483          Set_Priority (Self_ID, Self_ID.Common.Base_Priority);
 484       end if;
 485    end Complete_Restricted_Activation;
 486
 487    ------------------------------
 488    -- Complete_Restricted_Task --
 489    ------------------------------
 490
 491    procedure Complete_Restricted_Task is
 492    begin
 493       STPO.Self.Common.State := Terminated;
 494    end Complete_Restricted_Task;
 495
 496    ----------------------------
 497    -- Create_Restricted_Task --
 498    ----------------------------
 499
 500    procedure Create_Restricted_Task
 501      (Priority      : Integer;
 502       Stack_Address : System.Address;
 503       Size          : System.Parameters.Size_Type;
 504       Task_Info     : System.Task_Info.Task_Info_Type;
 505       CPU           : Integer;
 506       State         : Task_Procedure_Access;
 507       Discriminants : System.Address;
 508       Elaborated    : Access_Boolean;
 509       Task_Image    : String;
 510       Created_Task  : Task_Id)
 511    is
 512       Self_ID       : constant Task_Id := STPO.Self;
 513       Base_Priority : System.Any_Priority;
 514       Base_CPU      : System.Multiprocessors.CPU_Range;
 515       Success       : Boolean;
 516       Len           : Integer;
 517
 518    begin
 519       --  Stack is not preallocated on this target, so that Stack_Address must
 520       --  be null.
 521
 522       pragma Assert (Stack_Address = Null_Address);
 523
 524       Base_Priority :=
 525         (if Priority = Unspecified_Priority
 526          then Self_ID.Common.Base_Priority
 527          else System.Any_Priority (Priority));
 528
 529       --  Legal values of CPU are the special Unspecified_CPU value which is
 530       --  inserted by the compiler for tasks without CPU aspect, and those in
 531       --  the range of CPU_Range but no greater than Number_Of_CPUs. Otherwise
 532       --  the task is defined to have failed, and it becomes a completed task
 533       --  (RM D.16(14/3)).
 534
 535       if CPU /= Unspecified_CPU
 536         and then (CPU < Integer (System.Multiprocessors.CPU_Range'First)
 537           or else CPU > Integer (System.Multiprocessors.CPU_Range'Last)
 538           or else CPU > Integer (System.Multiprocessors.Number_Of_CPUs))
 539       then
 540          raise Tasking_Error with "CPU not in range";
 541
 542       --  Normal CPU affinity
 543       else
 544          --  When the application code says nothing about the task affinity
 545          --  (task without CPU aspect) then the compiler inserts the
 546          --  Unspecified_CPU value which indicates to the run-time library that
 547          --  the task will activate and execute on the same processor as its
 548          --  activating task if the activating task is assigned a processor
 549          --  (RM D.16(14/3)).
 550
 551          Base_CPU :=
 552            (if CPU = Unspecified_CPU
 553             then Self_ID.Common.Base_CPU
 554             else System.Multiprocessors.CPU_Range (CPU));
 555       end if;
 556
 557       if Single_Lock then
 558          Lock_RTS;
 559       end if;
 560
 561       Write_Lock (Self_ID);
 562
 563       --  With no task hierarchy, the parent of all non-Environment tasks that
 564       --  are created must be the Environment task. Dispatching domains are
 565       --  not allowed in Ravenscar, so the dispatching domain parameter will
 566       --  always be null.
 567
 568       Initialize_ATCB
 569         (Self_ID, State, Discriminants, Self_ID, Elaborated, Base_Priority,
 570          Base_CPU, null, Task_Info, Size, Created_Task, Success);
 571
 572       --  If we do our job right then there should never be any failures, which
 573       --  was probably said about the Titanic; so just to be safe, let's retain
 574       --  this code for now
 575
 576       if not Success then
 577          Unlock (Self_ID);
 578
 579          if Single_Lock then
 580             Unlock_RTS;
 581          end if;
 582
 583          raise Program_Error;
 584       end if;
 585
 586       Created_Task.Entry_Calls (1).Self := Created_Task;
 587
 588       Len :=
 589         Integer'Min (Created_Task.Common.Task_Image'Length, Task_Image'Length);
 590       Created_Task.Common.Task_Image_Len := Len;
 591       Created_Task.Common.Task_Image (1 .. Len) :=
 592         Task_Image (Task_Image'First .. Task_Image'First + Len - 1);
 593
 594       Unlock (Self_ID);
 595
 596       if Single_Lock then
 597          Unlock_RTS;
 598       end if;
 599
 600       --  Create TSD as early as possible in the creation of a task, since it
 601       --  may be used by the operation of Ada code within the task.
 602
 603       SSL.Create_TSD (Created_Task.Common.Compiler_Data);
 604    end Create_Restricted_Task;
 605
 606    procedure Create_Restricted_Task
 607      (Priority      : Integer;
 608       Stack_Address : System.Address;
 609       Size          : System.Parameters.Size_Type;
 610       Task_Info     : System.Task_Info.Task_Info_Type;
 611       CPU           : Integer;
 612       State         : Task_Procedure_Access;
 613       Discriminants : System.Address;
 614       Elaborated    : Access_Boolean;
 615       Chain         : in out Activation_Chain;
 616       Task_Image    : String;
 617       Created_Task  : Task_Id)
 618    is
 619    begin
 620       if Partition_Elaboration_Policy = 'S' then
 621
 622          --  A unit may have been compiled without partition elaboration
 623          --  policy, and in this case the compiler will emit calls for the
 624          --  default policy (concurrent). But if the partition policy is
 625          --  sequential, activation must be deferred.
 626
 627          Create_Restricted_Task_Sequential
 628            (Priority, Stack_Address, Size, Task_Info, CPU, State,
 629             Discriminants, Elaborated, Task_Image, Created_Task);
 630
 631       else
 632          Create_Restricted_Task
 633            (Priority, Stack_Address, Size, Task_Info, CPU, State,
 634             Discriminants, Elaborated, Task_Image, Created_Task);
 635
 636          --  Append this task to the activation chain
 637
 638          Created_Task.Common.Activation_Link := Chain.T_ID;
 639          Chain.T_ID := Created_Task;
 640       end if;
 641    end Create_Restricted_Task;
 642
 643    ---------------------------------------
 644    -- Create_Restricted_Task_Sequential --
 645    ---------------------------------------
 646
 647    procedure Create_Restricted_Task_Sequential
 648      (Priority      : Integer;
 649       Stack_Address : System.Address;
 650       Size          : System.Parameters.Size_Type;
 651       Task_Info     : System.Task_Info.Task_Info_Type;
 652       CPU           : Integer;
 653       State         : Task_Procedure_Access;
 654       Discriminants : System.Address;
 655       Elaborated    : Access_Boolean;
 656       Task_Image    : String;
 657       Created_Task  : Task_Id) is
 658    begin
 659       Create_Restricted_Task (Priority, Stack_Address, Size, Task_Info,
 660                               CPU, State, Discriminants, Elaborated,
 661                               Task_Image, Created_Task);
 662
 663       --  Append this task to the activation chain
 664
 665       Created_Task.Common.Activation_Link := Tasks_Activation_Chain;
 666       Tasks_Activation_Chain := Created_Task;
 667    end Create_Restricted_Task_Sequential;
 668
 669    ---------------------------
 670    -- Finalize_Global_Tasks --
 671    ---------------------------
 672
 673    --  This is needed to support the compiler interface; it will only be called
 674    --  by the Environment task. Instead, it will cause the Environment to block
 675    --  forever, since none of the dependent tasks are expected to terminate
 676
 677    procedure Finalize_Global_Tasks is
 678       Self_ID : constant Task_Id := STPO.Self;
 679
 680    begin
 681       pragma Assert (Self_ID = STPO.Environment_Task);
 682
 683       if Single_Lock then
 684          Lock_RTS;
 685       end if;
 686
 687       --  Handle normal task termination by the environment task, but only for
 688       --  the normal task termination. In the case of Abnormal and
 689       --  Unhandled_Exception they must have been handled before, and the task
 690       --  termination soft link must have been changed so the task termination
 691       --  routine is not executed twice.
 692
 693       --  Note that in the "normal" implementation in s-tassta.adb the task
 694       --  termination procedure for the environment task should be executed
 695       --  after termination of library-level tasks. However, this
 696       --  implementation is to be used when the Ravenscar restrictions are in
 697       --  effect, and AI-394 says that if there is a fall-back handler set for
 698       --  the partition it should be called when the first task (including the
 699       --  environment task) attempts to terminate.
 700
 701       SSL.Task_Termination_Handler.all (Ada.Exceptions.Null_Occurrence);
 702
 703       Write_Lock (Self_ID);
 704       Sleep (Self_ID, Master_Completion_Sleep);
 705       Unlock (Self_ID);
 706
 707       if Single_Lock then
 708          Unlock_RTS;
 709       end if;
 710
 711       --  Should never return from Master Completion Sleep
 712
 713       raise Program_Error;
 714    end Finalize_Global_Tasks;
 715
 716    ---------------------------
 717    -- Restricted_Terminated --
 718    ---------------------------
 719
 720    function Restricted_Terminated (T : Task_Id) return Boolean is
 721    begin
 722       return T.Common.State = Terminated;
 723    end Restricted_Terminated;
 724
 725    --------------------
 726    -- Terminate_Task --
 727    --------------------
 728
 729    procedure Terminate_Task (Self_ID : Task_Id) is
 730    begin
 731       Self_ID.Common.State := Terminated;
 732    end Terminate_Task;
 733
 734    --------------
 735    -- Init_RTS --
 736    --------------
 737
 738    procedure Init_RTS is
 739    begin
 740       Tasking.Initialize;
 741
 742       --  Initialize lock used to implement mutual exclusion between all tasks
 743
 744       STPO.Initialize_Lock (Global_Task_Lock'Access, STPO.Global_Task_Level);
 745
 746       --  Notify that the tasking run time has been elaborated so that
 747       --  the tasking version of the soft links can be used.
 748
 749       SSL.Lock_Task         := Task_Lock'Access;
 750       SSL.Unlock_Task       := Task_Unlock'Access;
 751       SSL.Adafinal          := Finalize_Global_Tasks'Access;
 752       SSL.Get_Current_Excep := Get_Current_Excep'Access;
 753
 754       --  Initialize the tasking soft links (if not done yet) that are common
 755       --  to the full and the restricted run times.
 756
 757       SSL.Tasking.Init_Tasking_Soft_Links;
 758    end Init_RTS;
 759
 760 begin
 761    Init_RTS;
 762 end System.Tasking.Restricted.Stages;