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-2011, 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 ------------------------------------------------------------------------------
33 -- Turn off polling, we do not want ATC polling to take place during tasking
34 -- operations. It causes infinite loops and other problems.
36 with Ada.Unchecked_Deallocation;
38 with System.Task_Primitives.Operations;
39 with System.Storage_Elements;
41 package body System.Tasking is
43 package STPO renames System.Task_Primitives.Operations;
45 ----------------------------
46 -- Free_Entry_Names_Array --
47 ----------------------------
49 procedure Free_Entry_Names_Array (Obj : in out Entry_Names_Array) is
50 procedure Free_String is new
51 Ada.Unchecked_Deallocation (String, String_Access);
53 for Index in Obj'Range loop
54 Free_String (Obj (Index));
56 end Free_Entry_Names_Array;
62 function Detect_Blocking return Boolean is
63 GL_Detect_Blocking : Integer;
64 pragma Import (C, GL_Detect_Blocking, "__gl_detect_blocking");
65 -- Global variable exported by the binder generated file. A value equal
66 -- to 1 indicates that pragma Detect_Blocking is active, while 0 is used
67 -- for the pragma not being present.
70 return GL_Detect_Blocking = 1;
77 function Self return Task_Id renames STPO.Self;
83 function Storage_Size (T : Task_Id) return System.Parameters.Size_Type is
86 System.Parameters.Size_Type
87 (T.Common.Compiler_Data.Pri_Stack_Info.Size);
94 procedure Initialize_ATCB
96 Task_Entry_Point : Task_Procedure_Access;
97 Task_Arg : System.Address;
99 Elaborated : Access_Boolean;
100 Base_Priority : System.Any_Priority;
101 Base_CPU : System.Multiprocessors.CPU_Range;
102 Domain : Dispatching_Domain_Access;
103 Task_Info : System.Task_Info.Task_Info_Type;
104 Stack_Size : System.Parameters.Size_Type;
106 Success : out Boolean)
109 T.Common.State := Unactivated;
111 -- Initialize T.Common.LL
113 STPO.Initialize_TCB (T, Success);
119 -- Wouldn't the following be better done using an assignment of an
120 -- aggregate so that we could be sure no components were forgotten???
122 T.Common.Parent := Parent;
123 T.Common.Base_Priority := Base_Priority;
124 T.Common.Base_CPU := Base_CPU;
125 T.Common.Domain := Domain;
126 T.Common.Current_Priority := 0;
127 T.Common.Protected_Action_Nesting := 0;
128 T.Common.Call := null;
129 T.Common.Task_Arg := Task_Arg;
130 T.Common.Task_Entry_Point := Task_Entry_Point;
131 T.Common.Activator := Self_ID;
132 T.Common.Wait_Count := 0;
133 T.Common.Elaborated := Elaborated;
134 T.Common.Activation_Failed := False;
135 T.Common.Task_Info := Task_Info;
136 T.Common.Global_Task_Lock_Nesting := 0;
137 T.Common.Fall_Back_Handler := null;
138 T.Common.Specific_Handler := null;
139 T.Common.Debug_Events := (others => False);
141 if T.Common.Parent = null then
143 -- For the environment task, the adjusted stack size is meaningless.
144 -- For example, an unspecified Stack_Size means that the stack size
145 -- is determined by the environment, or can grow dynamically. The
146 -- Stack_Checking algorithm therefore needs to use the requested
147 -- size, or 0 in case of an unknown size.
149 T.Common.Compiler_Data.Pri_Stack_Info.Size :=
150 Storage_Elements.Storage_Offset (Stack_Size);
153 T.Common.Compiler_Data.Pri_Stack_Info.Size :=
154 Storage_Elements.Storage_Offset
155 (Parameters.Adjust_Storage_Size (Stack_Size));
158 -- Link the task into the list of all tasks
160 T.Common.All_Tasks_Link := All_Tasks_List;
168 Main_Task_Image : constant String := "main_task";
169 -- Image of environment task
171 Main_Priority : Integer;
172 pragma Import (C, Main_Priority, "__gl_main_priority");
173 -- Priority for main task. Note that this is of type Integer, not Priority,
174 -- because we use the value -1 to indicate the default main priority, and
175 -- that is of course not in Priority'range.
178 pragma Import (C, Main_CPU, "__gl_main_cpu");
179 -- Affinity for main task. Note that this is of type Integer, not
180 -- CPU_Range, because we use the value -1 to indicate the unassigned
181 -- affinity, and that is of course not in CPU_Range'Range.
183 Initialized : Boolean := False;
184 -- Used to prevent multiple calls to Initialize
186 procedure Initialize is
188 Base_Priority : Any_Priority;
189 Base_CPU : System.Multiprocessors.CPU_Range;
192 use type System.Multiprocessors.CPU_Range;
201 -- Initialize Environment Task
204 (if Main_Priority = Unspecified_Priority
205 then Default_Priority
206 else Priority (Main_Priority));
209 (if Main_CPU = Unspecified_CPU
210 then System.Multiprocessors.Not_A_Specific_CPU
211 else System.Multiprocessors.CPU_Range (Main_CPU));
213 T := STPO.New_ATCB (0);
215 (null, null, Null_Address, Null_Task, null, Base_Priority, Base_CPU,
216 null, Task_Info.Unspecified_Task_Info, 0, T, Success);
217 pragma Assert (Success);
220 STPO.Set_Priority (T, T.Common.Base_Priority);
221 T.Common.State := Runnable;
222 T.Common.Task_Image_Len := Main_Task_Image'Length;
223 T.Common.Task_Image (Main_Task_Image'Range) := Main_Task_Image;
225 -- At program start-up the environment task is allocated to the default
226 -- system dispatching domain.
227 -- Make sure that the processors which are not available are not taken
228 -- into account. Use Number_Of_CPUs to know the exact number of
229 -- processors in the system at execution time.
232 new Dispatching_Domain'
233 (Multiprocessors.CPU'First .. Multiprocessors.Number_Of_CPUs =>
236 T.Common.Domain := System_Domain;
238 Dispatching_Domain_Tasks :=
239 new Array_Allocated_Tasks'
240 (Multiprocessors.CPU'First .. Multiprocessors.Number_Of_CPUs => 0);
242 -- Signal that this task is being allocated to a processor
244 if Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then
246 -- Increase the number of tasks attached to the CPU to which this
247 -- task is allocated.
249 Dispatching_Domain_Tasks (Base_CPU) :=
250 Dispatching_Domain_Tasks (Base_CPU) + 1;
253 -- Only initialize the first element since others are not relevant
254 -- in ravenscar mode. Rest of the initialization is done in Init_RTS.
256 T.Entry_Calls (1).Self := T;