File : s-taprop-pikeos.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S --
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 ------------------------------------------------------------------------------
28
29 -- This is the pikeos version of this package
30
31 -- This package contains all the GNULL primitives that interface directly with
32 -- the underlying kernel.
33
34 pragma Restrictions (No_Elaboration_Code);
35
36 with Ada.Unchecked_Conversion;
37
38 with System.Storage_Elements;
39 with System.Tasking.Debug;
40
41 package body System.Task_Primitives.Operations is
42
43 use System.OS_Interface;
44 use System.Parameters;
45 use System.Storage_Elements;
46
47 use type System.Tasking.Task_Id;
48
49 ---------------------
50 -- Local Functions --
51 ---------------------
52
53 function To_Address is new
54 Ada.Unchecked_Conversion (ST.Task_Id, System.Address);
55
56 function To_Task_Id is new
57 Ada.Unchecked_Conversion (System.Address, ST.Task_Id);
58
59 ----------
60 -- Self --
61 ----------
62
63 function Self return ST.Task_Id is
64 begin
65 return To_Task_Id (System.OS_Interface.Get_ATCB);
66 end Self;
67
68 -----------
69 -- Sleep --
70 -----------
71
72 procedure Sleep
73 (Self_ID : ST.Task_Id;
74 Reason : System.Tasking.Task_States)
75 is
76 pragma Unreferenced (Reason);
77 begin
78 -- A task can only suspend itself
79
80 pragma Assert (Self_ID = Self);
81
82 System.OS_Interface.Sleep;
83 end Sleep;
84
85 -----------------
86 -- Delay_Until --
87 -----------------
88
89 procedure Delay_Until (Abs_Time : Time) is
90 Self_ID : constant ST.Task_Id := Self;
91 begin
92 Self_ID.Common.State := ST.Delay_Sleep;
93 System.OS_Interface.Delay_Until (System.OS_Interface.Time (Abs_Time));
94 Self_ID.Common.State := ST.Runnable;
95 end Delay_Until;
96
97 ---------------------
98 -- Monotonic_Clock --
99 ---------------------
100
101 function Monotonic_Clock return Time is
102 begin
103 return Time (System.OS_Interface.Clock);
104 end Monotonic_Clock;
105
106 ------------
107 -- Wakeup --
108 ------------
109
110 procedure Wakeup (T : ST.Task_Id; Reason : System.Tasking.Task_States) is
111 pragma Unreferenced (Reason);
112 begin
113 System.OS_Interface.Wakeup (T.Common.LL.Thread);
114 end Wakeup;
115
116 ------------------
117 -- Set_Priority --
118 ------------------
119
120 procedure Set_Priority (T : ST.Task_Id; Prio : ST.Extended_Priority) is
121 begin
122 -- A task can only change its own priority
123
124 pragma Assert (T = Self);
125
126 -- Change the priority in the underlying executive
127
128 System.OS_Interface.Set_Priority (Prio);
129 end Set_Priority;
130
131 ------------------
132 -- Get_Priority --
133 ------------------
134
135 function Get_Priority (T : ST.Task_Id) return ST.Extended_Priority is
136 begin
137 -- Get current active priority
138
139 return System.OS_Interface.Get_Priority (T.Common.LL.Thread);
140 end Get_Priority;
141
142 ------------------
143 -- Get_Affinity --
144 ------------------
145
146 function Get_Affinity
147 (T : ST.Task_Id) return System.Multiprocessors.CPU_Range
148 is
149 begin
150 return System.OS_Interface.Get_Affinity (T.Common.LL.Thread);
151 end Get_Affinity;
152
153 -------------
154 -- Get_CPU --
155 -------------
156
157 function Get_CPU (T : ST.Task_Id) return System.Multiprocessors.CPU is
158 begin
159
160 return System.OS_Interface.Get_CPU (T.Common.LL.Thread);
161 end Get_CPU;
162
163 -------------------
164 -- Get_Thread_Id --
165 -------------------
166
167 function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is
168 begin
169 return T.Common.LL.Thread;
170 end Get_Thread_Id;
171
172 ----------------
173 -- Enter_Task --
174 ----------------
175
176 procedure Enter_Task (Self_ID : ST.Task_Id) is
177 begin
178 -- Notify the underlying executive about the Ada task that is being
179 -- executed by the running thread.
180
181 System.OS_Interface.Set_ATCB (To_Address (Self_ID));
182
183 -- Set lwp (for gdb)
184
185 Self_ID.Common.LL.Lwp := Lwp_Self;
186
187 -- Register the task to System.Tasking.Debug
188
189 System.Tasking.Debug.Add_Task_Id (Self_ID);
190
191 -- Ensure that the task has the right priority priority at the end
192 -- of its initialization (before calling the task's code).
193
194 System.OS_Interface.Set_Priority (Self_ID.Common.Base_Priority);
195 end Enter_Task;
196
197 --------------------
198 -- Initialize_TCB --
199 --------------------
200
201 procedure Initialize_TCB (Self_ID : ST.Task_Id; Succeeded : out Boolean) is
202 pragma Unreferenced (Self_ID);
203 begin
204 -- Nothing to be done as part of the initialization of TCBs
205
206 Succeeded := True;
207 end Initialize_TCB;
208
209 -----------------
210 -- Create_Task --
211 -----------------
212
213 procedure Create_Task
214 (T : ST.Task_Id;
215 Wrapper : System.Address;
216 Stack_Size : System.Parameters.Size_Type;
217 Priority : ST.Extended_Priority;
218 Base_CPU : System.Multiprocessors.CPU_Range;
219 Succeeded : out Boolean)
220 is
221 begin
222 -- The stack has been preallocated for these targets
223
224 pragma Assert
225 (T.Common.Compiler_Data.Pri_Stack_Info.Start_Address /= Null_Address
226 and then Storage_Offset (Stack_Size) =
227 T.Common.Compiler_Data.Pri_Stack_Info.Size);
228
229 T.Common.LL.Thread := T.Common.LL.Thread_Desc'Access;
230
231 -- Create the underlying task
232
233 System.OS_Interface.Thread_Create
234 (T.Common.LL.Thread,
235 Wrapper,
236 To_Address (T),
237 Priority,
238 Base_CPU,
239 T.Common.Compiler_Data.Pri_Stack_Info.Start_Address,
240 Size_Type (T.Common.Compiler_Data.Pri_Stack_Info.Size));
241
242 Succeeded := True;
243 end Create_Task;
244
245 ----------------
246 -- Initialize --
247 ----------------
248
249 procedure Initialize (Environment_Task : ST.Task_Id) is
250 begin
251 Environment_Task.Common.LL.Thread :=
252 Environment_Task.Common.LL.Thread_Desc'Access;
253
254 -- Clear Activation_Link, as required by Add_Task_Id
255
256 Environment_Task.Common.Activation_Link := null;
257
258 -- First the underlying multitasking executive must be initialized
259
260 System.OS_Interface.Initialize
261 (Environment_Task.Common.LL.Thread,
262 Environment_Task.Common.Base_Priority);
263
264 -- The environment task must also execute its initialization
265
266 Enter_Task (Environment_Task);
267
268 -- Store the identifier for the environment task
269
270 Operations.Environment_Task := Environment_Task;
271 end Initialize;
272
273 ---------------------
274 -- Is_Task_Context --
275 ---------------------
276
277 function Is_Task_Context return Boolean is
278 begin
279 return System.OS_Interface.Current_Interrupt = No_Interrupt;
280 end Is_Task_Context;
281
282 end System.Task_Primitives.Operations;