File : s-osinte-pikeos4.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- S Y S T E M . O S _ I N T E R F A C E --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2009-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 version of this package for PikeOS
33
34 -- This package encapsulates all direct interfaces to OS services that are
35 -- needed by the tasking run-time (libgnarl).
36
37 package body System.OS_Interface is
38
39 procedure Init_Thread (Id : Thread_Id);
40 -- Set components of Id.
41
42 -- Sycalls defined in p4.h
43
44 procedure p4_get_time_syscall (Res : Address);
45 pragma Import (C, p4_get_time_syscall);
46
47 function p4_sleep (Timeout : P4_timeout_t) return P4_e_t;
48 pragma Import (C, p4_sleep);
49
50 procedure p4_thread_yield;
51 pragma Import (C, p4_thread_yield);
52
53 function p4_my_uid_syscall return P4_uid_t;
54 pragma Import (C, p4_my_uid_syscall);
55
56 function p4_thread_stop_syscall
57 (Tnum : P4_thr_t; Flags : P4_uint32_t) return P4_e_t;
58 pragma Import (C, p4_thread_stop_syscall);
59
60 function p4_thread_resume (Tnum : P4_thr_t) return P4_e_t;
61 pragma Import (C, p4_thread_resume);
62
63 function p4_thread_ex_sched_syscall
64 (Tnum : P4_thr_t;
65 Old_Prio : Address;
66 Old_Tp : Address;
67 New_Prio : P4_prio_t;
68 New_Tp : P4_uint32_t;
69 Flags : P4_uint32_t)
70 return P4_e_t;
71 pragma Import (C, p4_thread_ex_sched_syscall);
72
73 P4_THREAD_SCHED_FIRST : constant := 2**0;
74
75 function p4_fast_set_prio (New_Prio : P4_prio_t) return P4_prio_t;
76 pragma Import (C, p4_fast_set_prio);
77
78 function p4_thread_get_attr (Tnum : P4_thr_t; Attr : Address) return P4_e_t;
79 pragma Import (C, p4_thread_get_attr);
80
81 function p4_my_thread return P4_thr_t;
82 -- This function is documented as pseudo-syscall. The implementation is
83 -- only provided by a C static inline function.
84
85 function p4_thread_get_priority (Tnum : P4_thr_t; Prio : Address)
86 return P4_e_t;
87 -- This function is documented as pseudo-syscall. The implementation is
88 -- only provided by a C static inline function.
89
90 procedure p4_tls_init (tls : Address);
91 pragma Import (C, p4_tls_init, "__gnat_p4_tls_init");
92
93 procedure p4_tls_register (tls : Address);
94 pragma Import (C, p4_tls_register);
95
96 Max_Thread_Num : constant P4_thr_t := 512;
97 -- Maximum number of threads that can be created
98
99 type Thread_Id_Array is array (P4_thr_t range 0 .. Max_Thread_Num - 1) of
100 Thread_Id;
101 All_Threads : Thread_Id_Array := (others => null);
102 -- Array of tasks. Used to implement Get_ATCB.
103 -- ??? This duplicates system.tasking.debug.known_tasks.
104
105 Next_Thread : P4_thr_t := 0;
106 -- Number of the next thread to be created
107
108 ------------------------------
109 -- p4_thread_get_priority --
110 ------------------------------
111
112 function p4_thread_get_priority (Tnum : P4_thr_t; Prio : Address)
113 return P4_e_t is
114 begin
115 return p4_thread_ex_sched_syscall (Tnum, Prio, Null_Address,
116 P4_PRIO_KEEP, P4_TIMEPART_KEEP,
117 P4_THREAD_SCHED_FIRST);
118 end p4_thread_get_priority;
119
120 -------------------
121 -- p4_my_thread --
122 -------------------
123
124 function p4_my_thread return P4_thr_t is
125 Uid : constant P4_uid_t := p4_my_uid_syscall;
126
127 begin
128 -- The lower 9 bits
129
130 return Uid mod 512;
131 end p4_my_thread;
132
133 ------------------
134 -- Current_CPU --
135 ------------------
136
137 function Current_CPU return Multiprocessors.CPU is
138 begin
139 -- No multiprocessor support, always return the first CPU Id
140
141 return Multiprocessors.CPU'First;
142 end Current_CPU;
143
144 -------------------------
145 -- Current_Interrupt --
146 -------------------------
147
148 function Current_Interrupt return Interrupt_ID is
149 begin
150 return Thread_Self.Interrupt;
151 end Current_Interrupt;
152
153 -------------
154 -- Clock --
155 -------------
156
157 function Clock return Time is
158 Res : P4_time_t;
159 begin
160 p4_get_time_syscall (Res'Address);
161 return Res;
162 end Clock;
163
164 -------------------
165 -- Delay_Until --
166 -------------------
167
168 procedure Delay_Until (T : Time) is
169 Res : P4_e_t;
170
171 begin
172 Res := p4_sleep (T + P4_TIMEOUT_ABSOLUTE);
173
174 if Res = P4_E_BADTIMEOUT then
175
176 -- ARM D.2.3 7/2 requires a yield, even if delay is in the past or 0
177
178 p4_thread_yield;
179 end if;
180 end Delay_Until;
181
182 -----------------
183 -- Init_Thread --
184 -----------------
185
186 procedure Init_Thread (Id : Thread_Id) is
187 begin
188 All_Threads (Next_Thread) := Id;
189 Id.Num := Next_Thread;
190
191 Id.Interrupt := No_Interrupt;
192
193 p4_tls_init (Id.Tls'Address);
194 p4_tls_register (Id.Tls'Address);
195 end Init_Thread;
196
197 -----------------
198 -- Initialize --
199 -----------------
200
201 procedure Initialize
202 (Environment_Thread : Thread_Id;
203 Main_Priority : System.Any_Priority) is
204 Prev : P4_prio_t;
205 pragma Unreferenced (Prev);
206
207 begin
208 -- The environment thread is the first thread
209
210 pragma Assert (p4_my_thread = 0);
211 pragma Assert (Next_Thread = 0);
212
213 Init_Thread (Environment_Thread);
214
215 -- Set priority
216
217 Prev := p4_fast_set_prio (P4_prio_t (Main_Priority));
218
219 -- Find the next available thread number. It should be 1 but the
220 -- debugger stub (if enabled) creates two threads.
221
222 loop
223 Next_Thread := Next_Thread + 1;
224 exit when p4_thread_get_attr (Next_Thread, Null_Address) = P4_E_STATE;
225 end loop;
226 end Initialize;
227
228 -------------------
229 -- Set_Interrupt --
230 -------------------
231
232 procedure Set_Interrupt (Id : Interrupt_ID) is
233 Thread : constant Thread_Id := Thread_Self;
234 begin
235 -- Can only be set once
236
237 pragma Assert (Thread.Interrupt = No_Interrupt);
238 pragma Assert (Id /= No_Interrupt);
239
240 Thread.Interrupt := Id;
241 end Set_Interrupt;
242
243 ---------------------
244 -- Thread_Create --
245 ---------------------
246
247 procedure Thread_Create
248 (Id : Thread_Id;
249 Code : System.Address;
250 Arg : System.Address;
251 Priority : System.Any_Priority;
252 Base_CPU : System.Multiprocessors.CPU_Range;
253 Stack_Address : System.Address;
254 Stack_Size : System.Parameters.Size_Type)
255 is
256 pragma Unreferenced (Base_CPU);
257
258 function Gnat_p4_thread_create
259 (Num : P4_thr_t;
260 Prio : P4_prio_t;
261 Code : Address;
262 Arg : Address;
263 Stack : Address;
264 Stack_Size : System.Parameters.Size_Type) return P4_e_t;
265 pragma Import (C, Gnat_p4_thread_create, "__gnat_p4_thread_create");
266 -- Wrapper in C to make the implementation easier
267
268 Status : P4_e_t;
269 begin
270 -- Be sure there is enough room in the task array
271 pragma Assert (Next_Thread <= Max_Thread_Num);
272 pragma Assert (Stack_Address /= Null_Address);
273
274 Init_Thread (Id);
275
276 -- No need to atomically increment Next_Thread as only the environmental
277 -- task creates tasks, assuming a ravenscar implementation.
278
279 Next_Thread := Next_Thread + 1;
280
281 Status := Gnat_p4_thread_create
282 (Id.Num, P4_prio_t (Priority), Code, Arg,
283 Stack_Address, Stack_Size);
284 pragma Assert (Status = P4_E_OK);
285 end Thread_Create;
286
287 -------------------
288 -- Thread_Self --
289 -------------------
290
291 function Thread_Self return Thread_Id is
292 Id : constant P4_thr_t := p4_my_thread;
293 begin
294 return All_Threads (Id);
295 end Thread_Self;
296
297 ----------------
298 -- Lwp_Self --
299 ----------------
300
301 function Lwp_Self return System.Address is
302 begin
303 -- This magic value matches the tid returned by gdbstub (as tid 0 is
304 -- reserved, the tids are shifted).
305
306 return Address (p4_my_thread + 1);
307 end Lwp_Self;
308
309 ----------------
310 -- Set_ATCB --
311 ----------------
312
313 procedure Set_ATCB (ATCB : System.Address) is
314 Id : constant P4_thr_t := p4_my_thread;
315 begin
316 All_Threads (Id).ATCB := ATCB;
317 end Set_ATCB;
318
319 ----------------
320 -- Get_ATCB --
321 ----------------
322
323 function Get_ATCB return System.Address is
324 Id : constant P4_thr_t := p4_my_thread;
325 begin
326 return All_Threads (Id).ATCB;
327 end Get_ATCB;
328
329 --------------------
330 -- Set_Priority --
331 --------------------
332
333 procedure Set_Priority (Priority : System.Any_Priority) is
334 Prev : P4_prio_t;
335 pragma Unreferenced (Prev);
336 begin
337 Prev := p4_fast_set_prio (P4_prio_t (Priority));
338 end Set_Priority;
339
340 --------------------
341 -- Get_Priority --
342 --------------------
343
344 function Get_Priority (Id : Thread_Id) return System.Any_Priority is
345 Status : P4_e_t;
346 Prio : P4_prio_t;
347 begin
348 Status := p4_thread_get_priority (Id.Num, Prio'Address);
349 pragma Assert (Status = P4_E_OK);
350 return Any_Priority (Prio);
351 end Get_Priority;
352
353 -------------
354 -- Sleep --
355 -------------
356
357 procedure Sleep is
358 Status : P4_e_t;
359 begin
360 Status := p4_thread_stop_syscall (p4_my_thread, 0);
361 pragma Assert (Status = P4_E_OK);
362 end Sleep;
363
364 --------------
365 -- Wakeup --
366 --------------
367
368 procedure Wakeup (Id : Thread_Id) is
369 Status : P4_e_t;
370 begin
371 Status := p4_thread_resume (Id.Num);
372 pragma Assert (Status = P4_E_OK);
373 end Wakeup;
374
375 --------------------
376 -- Get_Affinity --
377 --------------------
378
379 function Get_Affinity (Id : Thread_Id) return Multiprocessors.CPU_Range is
380 pragma Unreferenced (Id);
381
382 begin
383 -- No multiprocessor support, always return Not_A_Specific_CPU
384
385 return Multiprocessors.Not_A_Specific_CPU;
386 end Get_Affinity;
387
388 ---------------
389 -- Get_CPU --
390 ---------------
391
392 function Get_CPU (Id : Thread_Id) return Multiprocessors.CPU is
393 pragma Unreferenced (Id);
394
395 begin
396 -- No multiprocessor support, always return the first CPU Id
397
398 return Multiprocessors.CPU'First;
399 end Get_CPU;
400
401 end System.OS_Interface;