1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M . T A S K I N G --
9 -- Copyright (C) 1992-2024, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNARL was developed by the GNARL team at Florida State University. --
28 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
30 ------------------------------------------------------------------------------
32 with System
.Task_Primitives
.Operations
;
33 with System
.Storage_Elements
;
35 package body System
.Tasking
is
37 package STPO
renames System
.Task_Primitives
.Operations
;
43 function Detect_Blocking
return Boolean is
44 GL_Detect_Blocking
: Integer;
45 pragma Import
(C
, GL_Detect_Blocking
, "__gl_detect_blocking");
46 -- Global variable exported by the binder generated file. A value equal
47 -- to 1 indicates that pragma Detect_Blocking is active, while 0 is used
48 -- for the pragma not being present.
51 return GL_Detect_Blocking
= 1;
54 -----------------------
55 -- Number_Of_Entries --
56 -----------------------
58 function Number_Of_Entries
(Self_Id
: Task_Id
) return Entry_Index
is
60 return Entry_Index
(Self_Id
.Entry_Num
);
61 end Number_Of_Entries
;
67 function Self
return Task_Id
renames STPO
.Self
;
73 function Storage_Size
(T
: Task_Id
) return System
.Parameters
.Size_Type
is
76 System
.Parameters
.Size_Type
77 (T
.Common
.Compiler_Data
.Pri_Stack_Info
.Size
);
84 procedure Initialize_ATCB
86 Task_Entry_Point
: Task_Procedure_Access
;
87 Task_Arg
: System
.Address
;
89 Elaborated
: Access_Boolean
;
90 Base_Priority
: System
.Any_Priority
;
91 Base_CPU
: System
.Multiprocessors
.CPU_Range
;
92 Domain
: Dispatching_Domain_Access
;
93 Task_Info
: System
.Task_Info
.Task_Info_Type
;
94 Stack_Size
: System
.Parameters
.Size_Type
;
96 Success
: out Boolean)
99 T
.Common
.State
:= Unactivated
;
101 -- Initialize T.Common.LL
103 STPO
.Initialize_TCB
(T
, Success
);
109 -- Note that use of an aggregate here for this assignment
110 -- would be illegal, because Common_ATCB is limited because
111 -- Task_Primitives.Private_Data is limited.
113 T
.Common
.Parent
:= Parent
;
114 T
.Common
.Base_Priority
:= Base_Priority
;
115 T
.Common
.Base_CPU
:= Base_CPU
;
117 -- The Domain defaults to that of the activator. But that can be null in
118 -- the case of foreign threads (see Register_Foreign_Thread), in which
119 -- case we default to the System_Domain.
121 if Domain
/= null then
122 T
.Common
.Domain
:= Domain
;
123 elsif Self_ID
.Common
.Domain
/= null then
124 T
.Common
.Domain
:= Self_ID
.Common
.Domain
;
126 T
.Common
.Domain
:= System_Domain
;
128 pragma Assert
(T
.Common
.Domain
/= null);
130 T
.Common
.Current_Priority
:= Priority
'First;
131 T
.Common
.Protected_Action_Nesting
:= 0;
132 T
.Common
.Call
:= null;
133 T
.Common
.Task_Arg
:= Task_Arg
;
134 T
.Common
.Task_Entry_Point
:= Task_Entry_Point
;
135 T
.Common
.Activator
:= Self_ID
;
136 T
.Common
.Wait_Count
:= 0;
137 T
.Common
.Elaborated
:= Elaborated
;
138 T
.Common
.Activation_Failed
:= False;
139 T
.Common
.Task_Info
:= Task_Info
;
140 T
.Common
.Global_Task_Lock_Nesting
:= 0;
141 T
.Common
.Fall_Back_Handler
:= null;
142 T
.Common
.Specific_Handler
:= null;
143 T
.Common
.Debug_Events
:= [others => False];
144 T
.Common
.Task_Image_Len
:= 0;
146 if T
.Common
.Parent
= null then
148 -- For the environment task, the adjusted stack size is meaningless.
149 -- For example, an unspecified Stack_Size means that the stack size
150 -- is determined by the environment, or can grow dynamically. The
151 -- Stack_Checking algorithm therefore needs to use the requested
152 -- size, or 0 in case of an unknown size.
154 T
.Common
.Compiler_Data
.Pri_Stack_Info
.Size
:=
155 Storage_Elements
.Storage_Offset
(Stack_Size
);
158 T
.Common
.Compiler_Data
.Pri_Stack_Info
.Size
:=
159 Storage_Elements
.Storage_Offset
160 (Parameters
.Adjust_Storage_Size
(Stack_Size
));
163 -- Link the task into the list of all tasks
165 T
.Common
.All_Tasks_Link
:= All_Tasks_List
;
173 Main_Task_Image
: constant String := "main_task";
174 -- Image of environment task
176 Main_Priority
: constant Integer;
177 pragma Import
(C
, Main_Priority
, "__gl_main_priority");
178 -- Priority for main task. Note that this is of type Integer, not Priority,
179 -- because we use the value -1 to indicate the default main priority, and
180 -- that is of course not in Priority'range.
182 Main_CPU
: constant Integer;
183 pragma Import
(C
, Main_CPU
, "__gl_main_cpu");
184 -- Affinity for main task. Note that this is of type Integer, not
185 -- CPU_Range, because we use the value -1 to indicate the unassigned
186 -- affinity, and that is of course not in CPU_Range'Range.
188 Initialized
: Boolean := False;
189 -- Used to prevent multiple calls to Initialize
191 procedure Initialize
is
193 Base_Priority
: Any_Priority
;
194 Base_CPU
: System
.Multiprocessors
.CPU_Range
;
197 use type System
.Multiprocessors
.CPU_Range
;
206 -- Initialize Environment Task
209 (if Main_Priority
= Unspecified_Priority
210 then Default_Priority
211 else Priority
(Main_Priority
));
214 (if Main_CPU
= Unspecified_CPU
215 then System
.Multiprocessors
.Not_A_Specific_CPU
216 else System
.Multiprocessors
.CPU_Range
(Main_CPU
));
218 -- At program start-up the environment task is allocated to the default
219 -- system dispatching domain.
220 -- Make sure that the processors which are not available are not taken
221 -- into account. Use Number_Of_CPUs to know the exact number of
222 -- processors in the system at execution time.
225 new Dispatching_Domain
'
226 (Multiprocessors.CPU'First .. Multiprocessors.Number_Of_CPUs =>
229 T := STPO.New_ATCB (0);
232 Task_Entry_Point => null,
233 Task_Arg => Null_Address,
236 Base_Priority => Base_Priority,
237 Base_CPU => Base_CPU,
238 Domain => System_Domain,
239 Task_Info => Task_Info.Unspecified_Task_Info,
243 pragma Assert (Success);
246 STPO.Set_Priority (T, T.Common.Base_Priority);
247 T.Common.State := Runnable;
248 T.Common.Task_Image_Len := Main_Task_Image'Length;
249 T.Common.Task_Image (Main_Task_Image'Range) := Main_Task_Image;
251 Dispatching_Domain_Tasks :=
252 new Array_Allocated_Tasks'
253 (Multiprocessors
.CPU
'First .. Multiprocessors
.Number_Of_CPUs
=> 0);
255 -- Signal that this task is being allocated to a processor
257 if Base_CPU
/= System
.Multiprocessors
.Not_A_Specific_CPU
then
259 -- Increase the number of tasks attached to the CPU to which this
260 -- task is allocated.
262 Dispatching_Domain_Tasks
(Base_CPU
) :=
263 Dispatching_Domain_Tasks
(Base_CPU
) + 1;
266 -- The full initialization of the environment task's Entry_Calls array
267 -- is deferred to Init_RTS because only the first element of the array
268 -- is used by the restricted Ravenscar runtime.
270 T
.Entry_Calls
(T
.Entry_Calls
'First).Self
:= T
;
271 T
.Entry_Calls
(T
.Entry_Calls
'First).Level
:= T
.Entry_Calls
'First;