File : s-taskin-raven.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 --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2016, AdaCore --
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. GNARL 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 -- --
19 -- --
20 -- --
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 -- This is the Ravenscar/HI-E and Ravenscar/full version of this package
33
34 pragma Restrictions (No_Elaboration_Code);
35 -- For Ravenscar/HI-E, this restriction is simply an optimization.
36 -- For Ravenscar/full, this restriction is required because the Initialize
37 -- procedure is called by s-init before the elaboration.
38
39 pragma Polling (Off);
40 -- Turn off polling, we do not want ATC polling to take place during tasking
41 -- operations. It causes infinite loops and other problems.
42
43 with System.Task_Primitives.Operations;
44 -- used for Self
45
46 with System.Secondary_Stack;
47 -- used for SS_Init
48 -- Default_Secondary_Stack_Size
49
50 package body System.Tasking is
51
52 use System.Secondary_Stack;
53 use System.Multiprocessors;
54
55 ------------------------
56 -- Local Declarations --
57 ------------------------
58
59 Main_Priority : Integer := Unspecified_Priority;
60 pragma Export (C, Main_Priority, "__gl_main_priority");
61 -- Priority associated with the environment task. By default, its value is
62 -- undefined, and can be set by using pragma Priority in the main program.
63
64 Main_CPU : Integer := Unspecified_CPU;
65 pragma Export (C, Main_CPU, "__gl_main_cpu");
66 -- Affinity associated with the environment task. By default, its value is
67 -- undefined, and can be set by using pragma CPU in the main program.
68 -- Switching the environment task to the right CPU is left to the user.
69
70 Environment_Task : aliased Ada_Task_Control_Block (Entry_Num => 0);
71 -- ATCB for the environment task. The name of this array is
72 -- 'Environment_Task', so that there is a nice display of the environment
73 -- task in GDB (which uses the suffix of the symbol).
74
75 -------------------
76 -- Get_Sec_Stack --
77 -------------------
78
79 function Get_Sec_Stack return Address is
80 begin
81 return Self.Common.Compiler_Data.Sec_Stack_Addr;
82 end Get_Sec_Stack;
83
84 ---------------------
85 -- Initialize_ATCB --
86 ---------------------
87
88 procedure Initialize_ATCB
89 (Task_Entry_Point : Task_Procedure_Access;
90 Task_Arg : System.Address;
91 Base_Priority : Extended_Priority;
92 Base_CPU : System.Multiprocessors.CPU_Range;
93 Task_Info : System.Task_Info.Task_Info_Type;
94 Stack_Address : System.Address;
95 Stack_Size : System.Parameters.Size_Type;
96 T : Task_Id;
97 Success : out Boolean)
98 is
99 begin
100 T.Common.State := Unactivated;
101
102 -- Initialize T.Common.LL
103
104 Task_Primitives.Operations.Initialize_TCB (T, Success);
105
106 if not Success then
107 return;
108 end if;
109
110 T.Common.Base_Priority := Base_Priority;
111 T.Common.Base_CPU := Base_CPU;
112 T.Common.Protected_Action_Nesting := 0;
113 T.Common.Task_Arg := Task_Arg;
114 T.Common.Task_Entry_Point := Task_Entry_Point;
115 T.Common.Task_Info := Task_Info;
116
117 T.Common.Compiler_Data.Pri_Stack_Info.Start_Address :=
118 Stack_Address;
119
120 T.Common.Compiler_Data.Pri_Stack_Info.Size :=
121 Storage_Elements.Storage_Offset
122 (Parameters.Adjust_Storage_Size (Stack_Size));
123 end Initialize_ATCB;
124
125 ----------------
126 -- Initialize --
127 ----------------
128
129 Secondary_Stack : aliased Storage_Elements.Storage_Array
130 (1 .. Storage_Elements.Storage_Offset
131 (Default_Secondary_Stack_Size));
132 for Secondary_Stack'Alignment use Standard'Maximum_Alignment;
133 pragma Warnings (Off, Secondary_Stack);
134 -- Secondary stack of the environmental task
135
136 Initialized : Boolean := False;
137 -- Used to prevent multiple calls to Initialize
138
139 procedure Initialize is
140 Base_Priority : Any_Priority;
141
142 Success : Boolean;
143 pragma Warnings (Off, Success);
144
145 begin
146 if Initialized then
147 return;
148 end if;
149
150 Initialized := True;
151
152 -- Compute priority
153
154 if Main_Priority = Unspecified_Priority then
155 Base_Priority := Default_Priority;
156 else
157 Base_Priority := Main_Priority;
158 end if;
159
160 Initialize_ATCB
161 (null, Null_Address, Base_Priority, CPU'First,
162 Task_Info.Unspecified_Task_Info, Null_Address, 0,
163 Environment_Task'Access, Success);
164
165 Task_Primitives.Operations.Initialize
166 (Environment_Task'Access);
167
168 -- Note: we used to set the priority at this point, but it is already
169 -- done in Enter_Task via s-taprop.Initialize.
170
171 Environment_Task.Common.State := Runnable;
172 Environment_Task.Entry_Call.Self := Environment_Task'Access;
173
174 -- Initialize the secondary stack
175
176 Environment_Task.Common.Compiler_Data.Sec_Stack_Addr :=
177 Secondary_Stack'Address;
178 SS_Init (Secondary_Stack'Address, Default_Secondary_Stack_Size);
179
180 -- No fall back handler by default
181
182 Fall_Back_Handler := null;
183
184 -- Legal values of CPU are the special Unspecified_CPU value, which is
185 -- inserted by the compiler for tasks without CPU aspect, and those in
186 -- the range of CPU_Range but no greater than Number_Of_CPUs. Otherwise
187 -- the task is defined to have failed, and it becomes a completed task
188 -- (RM D.16(14/3)).
189
190 -- Only accept CPU'First for CPU value, starting on a slave CPU is not
191 -- supported.
192
193 if Main_CPU /= Unspecified_CPU and then Main_CPU /= Integer (CPU'First)
194 then
195 -- Invalid CPU, will raise Tasking_Error after the environment task
196 -- is initialized (as exception propagation is supported in the full
197 -- Ravenscar profile).
198
199 raise Tasking_Error with "Main CPU is not the master one";
200 end if;
201 end Initialize;
202
203 ----------
204 -- Self --
205 ----------
206
207 function Self return Task_Id renames System.Task_Primitives.Operations.Self;
208
209 -------------------
210 -- Set_Sec_Stack --
211 -------------------
212
213 procedure Set_Sec_Stack (Stk : Address) is
214 begin
215 Self.Common.Compiler_Data.Sec_Stack_Addr := Stk;
216 end Set_Sec_Stack;
217
218 ------------------
219 -- Storage_Size --
220 ------------------
221
222 function Storage_Size (T : Task_Id) return System.Parameters.Size_Type is
223 begin
224 return
225 System.Parameters.Size_Type
226 (T.Common.Compiler_Data.Pri_Stack_Info.Size);
227 end Storage_Size;
228
229 end System.Tasking;