summaryrefslogtreecommitdiff
path: root/gcc/ada/s-taskin.ads
blob: 6c4404c2d6a63c675e51595f930e1aecd1baca40 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
------------------------------------------------------------------------------
--                                                                          --
--                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
--                                                                          --
--                        S Y S T E M . T A S K I N G                       --
--                                                                          --
--                                  S p e c                                 --
--                                                                          --
--                                                                          --
--          Copyright (C) 1992-2002, Free Software Foundation, Inc.         --
--                                                                          --
-- GNARL is free software; you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNARL; see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies, Inc. (http://www.gnat.com).     --
--                                                                          --
------------------------------------------------------------------------------

--  This package provides necessary type definitions for compiler interface.

--  Note: the compiler generates direct calls to this interface, via Rtsfind.
--  Any changes to this interface may require corresponding compiler changes.

with Ada.Exceptions;
--  Used for:  Exception_Id

with System.Parameters;
--  used for Size_Type

with System.Task_Info;
--  used for Task_Info_Type, Task_Image_Type

with System.Soft_Links;
--  used for TSD

with System.Task_Primitives;
--  used for Private_Data

with Unchecked_Conversion;

package System.Tasking is

   --  -------------------
   --  -- Locking Rules --
   --  -------------------
   --
   --  The following rules must be followed at all times, to prevent
   --  deadlock and generally ensure correct operation of locking.
   --
   --  . Never lock a lock unless abort is deferred.
   --
   --  . Never undefer abort while holding a lock.
   --
   --  . Overlapping critical sections must be properly nested,
   --    and locks must be released in LIFO order.
   --    e.g., the following is not allowed:
   --
   --         Lock (X);
   --         ...
   --         Lock (Y);
   --         ...
   --         Unlock (X);
   --         ...
   --         Unlock (Y);
   --
   --  Locks with lower (smaller) level number cannot be locked
   --  while holding a lock with a higher level number. (The level
   --  number is the number at the left.)
   --
   --  1. System.Tasking.PO_Simple.Protection.L (any PO lock)
   --  2. System.Tasking.Initialization.Global_Task_Lock (in body)
   --  3. System.Task_Primitives.Operations.Single_RTS_Lock
   --  4. System.Tasking.Ada_Task_Control_Block.LL.L (any TCB lock)
   --
   --  Clearly, there can be no circular chain of hold-and-wait
   --  relationships involving locks in different ordering levels.
   --
   --  We used to have Global_Task_Lock before Protection.L but this was
   --  clearly wrong since there can be calls to "new" inside protected
   --  operations. The new ordering prevents these failures.
   --
   --  Sometimes we need to hold two ATCB locks at the same time. To allow
   --  us to order the locking, each ATCB is given a unique serial
   --  number. If one needs to hold locks on several ATCBs at once,
   --  the locks with lower serial numbers must be locked first.
   --
   --  We don't always need to check the serial numbers, since
   --  the serial numbers are assigned sequentially, and so:
   --
   --  . The parent of a task always has a lower serial number.
   --  . The activator of a task always has a lower serial number.
   --  . The environment task has a lower serial number than any other task.
   --  . If the activator of a task is different from the task's parent,
   --    the parent always has a lower serial number than the activator.

   ---------------------------------
   -- Task_ID related definitions --
   ---------------------------------

   type Ada_Task_Control_Block;

   type Task_ID is access all Ada_Task_Control_Block;

   Null_Task : constant Task_ID;

   type Task_List is array (Positive range <>) of Task_ID;

   function Self return Task_ID;
   pragma Inline (Self);
   --  This is the compiler interface version of this function. Do not call
   --  from the run-time system.

   function To_Task_Id is new Unchecked_Conversion (System.Address, Task_ID);
   function To_Address is new Unchecked_Conversion (Task_ID, System.Address);

   -----------------------
   -- Enumeration types --
   -----------------------

   type Task_States is
     (Unactivated,
      --  Task has been created but has not been activated.
      --  It cannot be executing.

      --  Active states
      --  For all states from here down, the task has been activated.
      --  For all states from here down, except for Terminated, the task
      --  may be executing.
      --  Activator = null iff it has not yet completed activating.

      --  For all states from here down,
      --  the task has been activated, and may be executing.

      Runnable,
      --  Task is not blocked for any reason known to Ada.
      --  (It may be waiting for a mutex, though.)
      --  It is conceptually "executing" in normal mode.

      Terminated,
      --  The task is terminated, in the sense of ARM 9.3 (5).
      --  Any dependents that were waiting on terminate
      --  alternatives have been awakened and have terminated themselves.

      Activator_Sleep,
      --  Task is waiting for created tasks to complete activation.

      Acceptor_Sleep,
      --  Task is waiting on an accept or selective wait statement.

      Entry_Caller_Sleep,
      --  Task is waiting on an entry call.

      Async_Select_Sleep,
      --  Task is waiting to start the abortable part of an
      --  asynchronous select statement.

      Delay_Sleep,
      --  Task is waiting on a select statement with only a delay
      --  alternative open.

      Master_Completion_Sleep,
      --  Master completion has two phases.
      --  In Phase 1 the task is sleeping in Complete_Master
      --  having completed a master within itself,
      --  and is waiting for the tasks dependent on that master to become
      --  terminated or waiting on a terminate Phase.

      Master_Phase_2_Sleep,
      --  In Phase 2 the task is sleeping in Complete_Master
      --  waiting for tasks on terminate alternatives to finish
      --  terminating.

      --  The following are special uses of sleep, for server tasks
      --  within the run-time system.

      Interrupt_Server_Idle_Sleep,
      Interrupt_Server_Blocked_Interrupt_Sleep,
      Timer_Server_Sleep,
      AST_Server_Sleep,

      Asynchronous_Hold,
      --  The task has been held by Asynchronous_Task_Control.Hold_Task

      Interrupt_Server_Blocked_On_Event_Flag
      --  The task has been blocked on a system call waiting for the
      --  completion event.
     );

   type Call_Modes is
     (Simple_Call, Conditional_Call, Asynchronous_Call, Timed_Call);

   type Select_Modes is (Simple_Mode, Else_Mode, Terminate_Mode, Delay_Mode);

   subtype Delay_Modes is Integer;

   -------------------------------
   -- Entry related definitions --
   -------------------------------

   Null_Entry : constant := 0;

   Max_Entry : constant := Integer'Last;

   Interrupt_Entry : constant := -2;

   Cancelled_Entry : constant := -1;

   type Entry_Index is range Interrupt_Entry .. Max_Entry;

   Null_Task_Entry : constant := Null_Entry;

   Max_Task_Entry : constant := Max_Entry;

   type Task_Entry_Index is new Entry_Index
     range Null_Task_Entry .. Max_Task_Entry;

   type Entry_Call_Record;

   type Entry_Call_Link is access all Entry_Call_Record;

   type Entry_Queue is record
      Head : Entry_Call_Link;
      Tail : Entry_Call_Link;
   end record;

   type Task_Entry_Queue_Array is
     array (Task_Entry_Index range <>) of Entry_Queue;

   ----------------------------------
   -- Entry_Call_Record definition --
   ----------------------------------

   type Entry_Call_State is
     (Never_Abortable,
      --  the call is not abortable, and never can be

      Not_Yet_Abortable,
      --  the call is not abortable, but may become so

      Was_Abortable,
      --  the call is not abortable, but once was

      Now_Abortable,
      --  the call is abortable

      Done,
      --  the call has been completed

      Cancelled
      --  the call was asynchronous, and was cancelled
     );

   --  Never_Abortable is used for calls that are made in a abort
   --  deferred region (see ARM 9.8(5-11), 9.8 (20)).
   --  Such a call is never abortable.

   --  The Was_ vs. Not_Yet_ distinction is needed to decide whether it
   --  is OK to advance into the abortable part of an async. select stmt.
   --  That is allowed iff the mode is Now_ or Was_.

   --  Done indicates the call has been completed, without cancellation,
   --  or no call has been made yet at this ATC nesting level,
   --  and so aborting the call is no longer an issue.
   --  Completion of the call does not necessarily indicate "success";
   --  the call may be returning an exception if Exception_To_Raise is
   --  non-null.

   --  Cancelled indicates the call was cancelled,
   --  and so aborting the call is no longer an issue.

   --  The call is on an entry queue unless
   --  State >= Done, in which case it may or may not be still Onqueue.

   --  Please do not modify the order of the values, without checking
   --  all uses of this type.  We rely on partial "monotonicity" of
   --  Entry_Call_Record.State to avoid locking when we access this
   --  value for certain tests.  In particular:

   --  1)  Once State >= Done, we can rely that the call has been
   --      completed.  If State >= Done, it will not
   --      change until the task does another entry call at this level.

   --  2)  Once State >= Was_Abortable, we can rely that the call has
   --      been queued abortably at least once, and so the check for
   --      whether it is OK to advance to the abortable part of an
   --      async. select statement does not need to lock anything.

   type Restricted_Entry_Call_Record is record
      Self : Task_ID;
      --  ID of the caller

      Mode : Call_Modes;

      State : Entry_Call_State;
      pragma Atomic (State);
      --  Indicates part of the state of the call.
      --  Protection:
      --  If the call is not on a queue, it should
      --  only be accessed by Self, and Self does not need any
      --  lock to modify this field.
      --  Once the call is on a queue, the value should be
      --  something other than Done unless it is cancelled, and access is
      --  controller by the "server" of the queue -- i.e., the lock
      --  of Checked_To_Protection (Call_Target)
      --  if the call record is on the queue of a PO, or the lock
      --  of Called_Target if the call is on the queue of a task.
      --  See comments on type declaration for more details.

      Uninterpreted_Data : System.Address;
      --  Data passed by the compiler.

      Exception_To_Raise : Ada.Exceptions.Exception_Id;
      --  The exception to raise once this call has been completed without
      --  being aborted.
   end record;
   pragma Suppress_Initialization (Restricted_Entry_Call_Record);

   ------------------------------------
   -- Task related other definitions --
   ------------------------------------

   type Activation_Chain is limited private;

   type Activation_Chain_Access is access all Activation_Chain;

   type Task_Procedure_Access is access procedure (Arg : System.Address);

   type Access_Boolean is access all Boolean;

   ----------------------------------------------
   -- Ada_Task_Control_Block (ATCB) definition --
   ----------------------------------------------

   --  Notes on protection (synchronization) of TRTS data structures.

   --  Any field of the TCB can be written by the activator of a task when the
   --  task is created, since no other task can access the new task's
   --  state until creation is complete.

   --  The protection for each field is described in a comment starting with
   --  "Protection:".

   --  When a lock is used to protect an ATCB field, this lock is simply named.

   --  Some protection is described in terms of tasks related to the
   --  ATCB being protected. These are:

   --    Self: The task which is controlled by this ATCB.
   --    Acceptor: A task accepting a call from Self.
   --    Caller: A task calling an entry of Self.
   --    Parent: The task executing the master on which Self depends.
   --    Dependent: A task dependent on Self.
   --    Activator: The task that created Self and initiated its activation.
   --    Created: A task created and activated by Self.

   --  Note: The order of the fields is important to implement efficiently
   --  tasking support under gdb.
   --  Currently gdb relies on the order of the State, Parent, Base_Priority,
   --  Task_Image, Call and LL fields.

   ----------------------------------------------------------------------
   --  Common ATCB section                                             --
   --                                                                  --
   --  This section is used by all GNARL implementations (regular and  --
   --  restricted)                                                     --
   ----------------------------------------------------------------------

   type Common_ATCB is record
      State : Task_States;
      pragma Atomic (State);
      --  Encodes some basic information about the state of a task,
      --  including whether it has been activated, whether it is sleeping,
      --  and whether it is terminated.
      --  Protection: Self.L.

      Parent : Task_ID;
      --  The task on which this task depends.
      --  See also Master_Level and Master_Within.

      Base_Priority : System.Any_Priority;
      --  Base priority, not changed during entry calls, only changed
      --  via dynamic priorities package.
      --  Protection: Only written by Self, accessed by anyone.

      Current_Priority : System.Any_Priority;
      --  Active priority, except that the effects of protected object
      --  priority ceilings are not reflected. This only reflects explicit
      --  priority changes and priority inherited through task activation
      --  and rendezvous.
      --
      --  Ada 95 notes: In Ada 95, this field will be transferred to the
      --  Priority field of an Entry_Calls component when an entry call
      --  is initiated. The Priority of the Entry_Calls component will not
      --  change for the duration of the call. The accepting task can
      --  use it to boost its own priority without fear of its changing in
      --  the meantime.
      --
      --  This can safely be used in the priority ordering
      --  of entry queues. Once a call is queued, its priority does not
      --  change.
      --
      --  Since an entry call cannot be made while executing
      --  a protected action, the priority of a task will never reflect a
      --  priority ceiling change at the point of an entry call.
      --
      --  Protection: Only written by Self, and only accessed when Acceptor
      --  accepts an entry or when Created activates, at which points Self is
      --  suspended.

      Task_Image : System.Task_Info.Task_Image_Type;
      --  holds an access to string that provides a readable id for task,
      --  built from the variable of which it is a value or component.

      Call : Entry_Call_Link;
      --  The entry call that has been accepted by this task.
      --  Protection: Self.L. Self will modify this field
      --  when Self.Accepting is False, and will not need the mutex to do so.
      --  Once a task sets Pending_ATC_Level = 0, no other task can access
      --  this field.

      LL : aliased Task_Primitives.Private_Data;
      --  Control block used by the underlying low-level tasking
      --  service (GNULLI).
      --  Protection: This is used only by the GNULLI implementation, which
      --  takes care of all of its synchronization.

      Task_Arg : System.Address;
      --  The argument to task procedure. Currently unused; this will
      --  provide a handle for discriminant information.
      --  Protection: Part of the synchronization between Self and
      --  Activator. Activator writes it, once, before Self starts
      --  executing. Thereafter, Self only reads it.

      Task_Entry_Point : Task_Procedure_Access;
      --  Information needed to call the procedure containing the code for
      --  the body of this task.
      --  Protection: Part of the synchronization between Self and
      --  Activator. Activator writes it, once, before Self starts
      --  executing. Self reads it, once, as part of its execution.

      Compiler_Data : System.Soft_Links.TSD;
      --  Task-specific data needed by the compiler to store
      --  per-task structures.
      --  Protection: Only accessed by Self.

      All_Tasks_Link : Task_ID;
      --  Used to link this task to the list of all tasks in the system.
      --  Protection: RTS_Lock.

      Activation_Link : Task_ID;
      --  Used to link this task to a list of tasks to be activated.
      --  Protection: Only used by Activator.

      Activator : Task_ID;
      --  The task that created this task, either by declaring it as a task
      --  object or by executing a task allocator.
      --  The value is null iff Self has completed activation.
      --  Protection: Set by Activator before Self is activated, and
      --  only read and modified by Self after that.

      Wait_Count : Integer;
      --  This count is used by a task that is waiting for other tasks.
      --  At all other times, the value should be zero.
      --  It is used differently in several different states.
      --  Since a task cannot be in more than one of these states at the
      --  same time, a single counter suffices.
      --  Protection: Self.L.

      --  Activator_Sleep

      --  This is the number of tasks that this task is activating, i.e. the
      --  children that have started activation but have not completed it.
      --  Protection: Self.L and Created.L. Both mutexes must be locked,
      --  since Self.Activation_Count and Created.State must be synchronized.

      --  Master_Completion_Sleep (phase 1)

      --  This is the number dependent tasks of a master being
      --  completed by Self that are not activated, not terminated, and
      --  not waiting on a terminate alternative.

      --  Master_Completion_2_Sleep (phase 2)

      --  This is the count of tasks dependent on a master being
      --  completed by Self which are waiting on a terminate alternative.

      Elaborated : Access_Boolean;
      --  Pointer to a flag indicating that this task's body has been
      --  elaborated. The flag is created and managed by the
      --  compiler-generated code.
      --  Protection: The field itself is only accessed by Activator. The flag
      --  that it points to is updated by Master and read by Activator; access
      --  is assumed to be atomic.

      Activation_Failed : Boolean;
      --  Set to True if activation of a chain of tasks fails,
      --  so that the activator should raise Tasking_Error.

      Task_Info : System.Task_Info.Task_Info_Type;
      --  System-specific attributes of the task as specified by the
      --  Task_Info pragma.
   end record;

   ---------------------------------------
   -- Restricted_Ada_Task_Control_Block --
   ---------------------------------------

   --  This type should only be used by the restricted GNARLI and by
   --  restricted GNULL implementations to allocate an ATCB (see
   --  System.Task_Primitives.Operations.New_ATCB) that will take
   --  significantly less memory.
   --  Note that the restricted GNARLI should only access fields that are
   --  present in the Restricted_Ada_Task_Control_Block structure.

   type Restricted_Ada_Task_Control_Block (Entry_Num : Task_Entry_Index) is
   record
      Common : Common_ATCB;
      --  The common part between various tasking implementations

      Entry_Call : aliased Restricted_Entry_Call_Record;
      --  Protection: This field is used on entry call "queues" associated
      --  with protected objects, and is protected by the protected object
      --  lock.
   end record;
   pragma Suppress_Initialization (Restricted_Ada_Task_Control_Block);

   Interrupt_Manager_ID : Task_ID;
   --  This task ID is declared here to break circular dependencies.
   --  Also declare Interrupt_Manager_ID after Task_ID is known, to avoid
   --  generating unneeded finalization code.

   -----------------------
   -- List of all Tasks --
   -----------------------

   All_Tasks_List : Task_ID;
   --  Global linked list of all tasks.

   ------------------------------------------
   -- Regular (non restricted) definitions --
   ------------------------------------------

   --------------------------------
   -- Master Related Definitions --
   --------------------------------

   subtype Master_Level is Integer;
   subtype Master_ID is Master_Level;

   --  Normally, a task starts out with internal master nesting level
   --  one larger than external master nesting level. It is incremented
   --  to one by Enter_Master, which is called in the task body only if
   --  the compiler thinks the task may have dependent tasks. It is set to 1
   --  for the environment task, the level 2 is reserved for server tasks of
   --  the run-time system (the so called "independent tasks"), and the level
   --  3 is for the library level tasks.

   Environment_Task_Level : constant Master_Level := 1;
   Independent_Task_Level : constant Master_Level := 2;
   Library_Task_Level     : constant Master_Level := 3;

   ------------------------------
   -- Task size, priority info --
   ------------------------------

   Unspecified_Priority : constant Integer := System.Priority'First - 1;

   Priority_Not_Boosted : constant Integer := System.Priority'First - 1;
   --  Definition of Priority actually has to come from the RTS configuration.

   subtype Rendezvous_Priority is Integer
     range Priority_Not_Boosted .. System.Any_Priority'Last;

   ------------------------------------
   -- Rendezvous related definitions --
   ------------------------------------

   No_Rendezvous : constant := 0;

   Max_Select : constant Integer := Integer'Last;
   --  RTS-defined

   subtype Select_Index is Integer range No_Rendezvous .. Max_Select;
   --   type Select_Index is range No_Rendezvous .. Max_Select;

   subtype Positive_Select_Index is
     Select_Index range 1 .. Select_Index'Last;

   type Accept_Alternative is record
      Null_Body : Boolean;
      S         : Task_Entry_Index;
   end record;

   type Accept_List is
     array (Positive_Select_Index range <>) of Accept_Alternative;

   type Accept_List_Access is access constant Accept_List;

   -----------------------------------
   -- ATC_Level related definitions --
   -----------------------------------

   Max_ATC_Nesting : constant Natural := 20;

   subtype ATC_Level_Base is Integer range 0 .. Max_ATC_Nesting;

   ATC_Level_Infinity : constant ATC_Level_Base := ATC_Level_Base'Last;

   subtype ATC_Level is ATC_Level_Base range 0 .. ATC_Level_Base'Last - 1;

   subtype ATC_Level_Index is ATC_Level range 1 .. ATC_Level'Last;

   ----------------------------------
   -- Entry_Call_Record definition --
   ----------------------------------

   type Entry_Call_Record is record
      Self  : Task_ID;
      --  ID of the caller

      Mode : Call_Modes;

      State : Entry_Call_State;
      pragma Atomic (State);
      --  Indicates part of the state of the call.
      --  Protection:
      --  If the call is not on a queue, it should
      --  only be accessed by Self, and Self does not need any
      --  lock to modify this field.
      --  Once the call is on a queue, the value should be
      --  something other than Done unless it is cancelled, and access is
      --  controller by the "server" of the queue -- i.e., the lock
      --  of Checked_To_Protection (Call_Target)
      --  if the call record is on the queue of a PO, or the lock
      --  of Called_Target if the call is on the queue of a task.
      --  See comments on type declaration for more details.

      Uninterpreted_Data : System.Address;
      --  Data passed by the compiler.

      Exception_To_Raise : Ada.Exceptions.Exception_Id;
      --  The exception to raise once this call has been completed without
      --  being aborted.

      Prev : Entry_Call_Link;

      Next : Entry_Call_Link;

      Level : ATC_Level;
      --  One of Self and Level are redundant in this implementation, since
      --  each Entry_Call_Record is at Self.Entry_Calls (Level). Since we must
      --  have access to the entry call record to be reading this, we could
      --  get Self from Level, or Level from Self. However, this requires
      --  non-portable address arithmetic.

      E : Entry_Index;

      Prio : System.Any_Priority;

      --  The above fields are those that there may be some hope of packing.
      --  They are gathered together to allow for compilers that lay records
      --  out contiguously, to allow for such packing.

      Called_Task : Task_ID;
      pragma Atomic (Called_Task);
      --  Use for task entry calls.
      --  The value is null if the call record is not in use.
      --  Conversely, unless State is Done and Onqueue is false,
      --  Called_Task points to an ATCB.
      --  Protection:  Called_Task.L.

      Called_PO : System.Address;
      pragma Atomic (Called_PO);
      --  Similar to Called_Task but for protected objects.
      --  Note that the previous implementation tried to merge both
      --  Called_Task and Called_PO but this ended up in many unexpected
      --  complications (e.g having to add a magic number in the ATCB, which
      --  caused gdb lots of confusion) with no real gain since the Lock_Server
      --  implementation still need to loop around chasing for pointer changes
      --  even with a single pointer.

      Acceptor_Prev_Call : Entry_Call_Link;
      --  For task entry calls only.

      Acceptor_Prev_Priority : Rendezvous_Priority := Priority_Not_Boosted;
      --  For task entry calls only.
      --  The priority of the most recent prior call being serviced.
      --  For protected entry calls, this function should be performed by
      --  GNULLI ceiling locking.

      Cancellation_Attempted : Boolean := False;
      pragma Atomic (Cancellation_Attempted);
      --  Cancellation of the call has been attempted.
      --  If it has succeeded, State = Cancelled.
      --  ?????
      --  Consider merging this into State?

      Requeue_With_Abort : Boolean := False;
      --  Temporary to tell caller whether requeue is with abort.
      --  ?????
      --  Find a better way of doing this.

      Needs_Requeue : Boolean := False;
      --  Temporary to tell acceptor of task entry call that
      --  Exceptional_Complete_Rendezvous needs to do requeue.
   end record;

   ------------------------------------
   -- Task related other definitions --
   ------------------------------------

   type Access_Address is access all System.Address;

   ----------------------------------------------
   -- Ada_Task_Control_Block (ATCB) definition --
   ----------------------------------------------

   type Entry_Call_Array is array (ATC_Level_Index) of
     aliased Entry_Call_Record;

   D_I_Count : constant := 2;
   --  This constant may be adjusted, to allow more Address-sized
   --  attributes to be stored directly in the task control block.

   subtype Direct_Index is Integer range 0 .. D_I_Count - 1;
   --  Attributes with indices in this range are stored directly in
   --  the task control block.  Such attributes must be Address-sized.
   --  Other attributes will be held in dynamically allocated records
   --  chained off of the task control block.

   type Direct_Attribute_Array is
     array (Direct_Index) of aliased System.Address;

   type Direct_Index_Vector is mod 2 ** D_I_Count;
   --  This is a bit-vector type, used to store information about
   --  the usage of the direct attribute fields.

   type Task_Serial_Number is mod 2 ** 64;
   --  Used to give each task a unique serial number.

   type Ada_Task_Control_Block (Entry_Num : Task_Entry_Index) is record
      Common : Common_ATCB;
      --  The common part between various tasking implementations

      Entry_Calls : Entry_Call_Array;
      --  An array of entry calls.
      --  Protection: The elements of this array are on entry call queues
      --  associated with protected objects or task entries, and are protected
      --  by the protected object lock or Acceptor.L, respectively.

      New_Base_Priority : System.Any_Priority;
      --  New value for Base_Priority (for dynamic priorities package).
      --  Protection: Self.L.

      Global_Task_Lock_Nesting : Natural := 0;
      --  This is the current nesting level of calls to
      --  System.Tasking.Stages.Lock_Task_T.
      --  This allows a task to call Lock_Task_T multiple times without
      --  deadlocking. A task only locks All_Task_Lock when its
      --  All_Tasks_Nesting goes from 0 to 1, and only unlocked when it
      --  goes from 1 to 0.
      --  Protection: Only accessed by Self.

      Open_Accepts : Accept_List_Access;
      --  This points to the Open_Accepts array of accept alternatives passed
      --  to the RTS by the compiler-generated code to Selective_Wait.
      --  It is non-null iff this task is ready to accept an entry call.
      --  Protection: Self.L.

      Chosen_Index : Select_Index;
      --  The index in Open_Accepts of the entry call accepted by a selective
      --  wait executed by this task.
      --  Protection: Written by both Self and Caller. Usually protected
      --  by Self.L. However, once the selection is known to have been
      --  written it can be accessed without protection. This happens
      --  after Self has updated it itself using information from a suspended
      --  Caller, or after Caller has updated it and awakened Self.

      Master_of_Task : Master_Level;
      --  The task executing the master of this task, and the ID of this task's
      --  master (unique only among masters currently active within Parent).
      --  Protection: Set by Activator before Self is activated, and
      --  read after Self is activated.

      Master_Within : Master_Level;
      --  The ID of the master currently executing within this task; that is,
      --  the most deeply nested currently active master.
      --  Protection: Only written by Self, and only read by Self or by
      --  dependents when Self is attempting to exit a master. Since Self
      --  will not write this field until the master is complete, the
      --  synchronization should be adequate to prevent races.

      Alive_Count : Integer := 0;
      --  Number of tasks directly dependent on this task (including itself)
      --  that are still "alive", i.e. not terminated.
      --  Protection: Self.L.

      Awake_Count : Integer := 0;
      --  Number of tasks directly dependent on this task (including itself)
      --  still "awake", i.e., are not terminated and not waiting on a
      --  terminate alternative.
      --  Invariant: Awake_Count <= Alive_Count
      --  Protection: Self.L.

      --  beginning of flags

      Aborting : Boolean := False;
      pragma Atomic (Aborting);
      --  Self is in the process of aborting. While set, prevents multiple
      --  abortion signals from being sent by different aborter while abortion
      --  is acted upon. This is essential since an aborter which calls
      --  Abort_To_Level could set the Pending_ATC_Level to yet a lower level
      --  (than the current level), may be preempted and would send the
      --  abortion signal when resuming execution. At this point, the abortee
      --  may have completed abortion to the proper level such that the
      --  signal (and resulting abortion exception) are not handled any more.
      --  In other words, the flag prevents a race between multiple aborters
      --  and the abortee.
      --  Protection: Self.L.

      ATC_Hack : Boolean := False;
      pragma Atomic (ATC_Hack);
      --  ?????
      --  Temporary fix, to allow Undefer_Abort to reset Aborting in the
      --  handler for Abort_Signal that encloses an async. entry call.
      --  For the longer term, this should be done via code in the
      --  handler itself.

      Callable : Boolean := True;
      --  It is OK to call entries of this task.

      Dependents_Aborted : Boolean := False;
      --  This is set to True by whichever task takes responsibility
      --  for aborting the dependents of this task.
      --  Protection: Self.L.

      Interrupt_Entry : Boolean := False;
      --  Indicates if one or more Interrupt Entries are attached to
      --  the task. This flag is needed for cleaning up the Interrupt
      --  Entry bindings.

      Pending_Action : Boolean := False;
      --  Unified flag indicating some action needs to be take when abort
      --  next becomes undeferred.  Currently set if:
      --  . Pending_Priority_Change is set
      --  . Pending_ATC_Level is changed
      --  . Requeue involving POs
      --    (Abortable field may have changed and the Wait_Until_Abortable
      --     has to recheck the abortable status of the call.)
      --  . Exception_To_Raise is non-null
      --  Protection: Self.L.
      --  This should never be reset back to False outside of the
      --  procedure Do_Pending_Action, which is called by Undefer_Abort.
      --  It should only be set to True by Set_Priority and Abort_To_Level.

      Pending_Priority_Change : Boolean := False;
      --  Flag to indicate pending priority change (for dynamic priorities
      --  package). The base priority is updated on the next abortion
      --  completion point (aka. synchronization point).
      --  Protection: Self.L.

      Terminate_Alternative : Boolean := False;
      --  Task is accepting Select with Terminate Alternative.
      --  Protection: Self.L.

      --  end of flags

      --  beginning of counts

      ATC_Nesting_Level : ATC_Level := 1;
      --  The dynamic level of ATC nesting (currently executing nested
      --  asynchronous select statements) in this task.
      --  Protection:  Self_ID.L.
      --  Only Self reads or updates this field.
      --  Decrementing it deallocates an Entry_Calls component, and care must
      --  be taken that all references to that component are eliminated
      --  before doing the decrement. This in turn will require locking
      --  a protected object (for a protected entry call) or the Acceptor's
      --  lock (for a task entry call).
      --  No other task should attempt to read or modify this value.

      Deferral_Level : Natural := 1;
      --  This is the number of times that Defer_Abortion has been called by
      --  this task without a matching Undefer_Abortion call. Abortion is
      --  only allowed when this zero.
      --  It is initially 1, to protect the task at startup.
      --  Protection: Only updated by Self; access assumed to be atomic.

      Pending_ATC_Level : ATC_Level_Base := ATC_Level_Infinity;
      --  The ATC level to which this task is currently being aborted.
      --  If the value is zero, the entire task has "completed".
      --  That may be via abort, exception propagation, or normal exit.
      --  If the value is ATC_Level_Infinity, the task is not being
      --  aborted to any level.
      --  If the value is positive, the task has not completed.
      --  This should ONLY be modified by
      --  Abort_To_Level and Exit_One_ATC_Level.
      --  Protection: Self.L.

      Serial_Number : Task_Serial_Number;
      --  A growing number to provide some way to check locking
      --  rules/ordering.

      Known_Tasks_Index : Integer := -1;
      --  Index in the System.Tasking.Debug.Known_Tasks array.

      User_State : Integer := 0;
      --  user-writeable location, for use in debugging tasks;
      --  debugger can display this value to show where the task currently
      --  is, in user terms

      Direct_Attributes : Direct_Attribute_Array;
      --  For task attributes that have same size as Address

      Is_Defined : Direct_Index_Vector := 0;
      --  Bit I is 1 iff Direct_Attributes (I) is defined

      Indirect_Attributes : Access_Address;
      --  A pointer to chain of records for other attributes that
      --  are not address-sized, including all tagged types.

      Entry_Queues : Task_Entry_Queue_Array (1 .. Entry_Num);
      --  An array of task entry queues.
      --  Protection: Self.L. Once a task has set Self.Stage to Completing, it
      --  has exclusive access to this field.
   end record;
   pragma Volatile (Ada_Task_Control_Block);

   ---------------------
   -- Initialize_ATCB --
   ---------------------

   procedure Initialize_ATCB
     (Self_ID          : Task_ID;
      Task_Entry_Point : Task_Procedure_Access;
      Task_Arg         : System.Address;
      Parent           : Task_ID;
      Elaborated       : Access_Boolean;
      Base_Priority    : System.Any_Priority;
      Task_Info        : System.Task_Info.Task_Info_Type;
      Stack_Size       : System.Parameters.Size_Type;
      T                : in out Task_ID;
      Success          : out Boolean);
   --  Initialize fields of a TCB and link into global TCB structures
   --  Call this only with abort deferred and holding RTS_Lock.

private

   Null_Task : constant Task_ID := null;

   type Activation_Chain is record
      T_ID : Task_ID;
   end record;
   pragma Volatile (Activation_Chain);

   --  Activation_chain is an in-out parameter of initialization procedures
   --  and it must be passed by reference because the init_proc may terminate
   --  abnormally after creating task components, and these must be properly
   --  registered for removal (Expunge_Unactivated_Tasks).

end System.Tasking;