]>
Commit | Line | Data |
---|---|---|
e6e7bf38 | 1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNU ADA 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 | -- -- | |
5d5958da | 9 | -- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- |
e6e7bf38 | 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- -- | |
6bc9506f | 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- -- | |
e6e7bf38 | 15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
6bc9506f | 16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
17 | -- -- | |
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. -- | |
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/>. -- | |
e6e7bf38 | 26 | -- -- |
9dfe12ae | 27 | -- GNARL was developed by the GNARL team at Florida State University. -- |
28 | -- Extensive contributions were provided by Ada Core Technologies, Inc. -- | |
e6e7bf38 | 29 | -- -- |
30 | ------------------------------------------------------------------------------ | |
31 | ||
f9c9d5d3 | 32 | -- This is a GNU/Linux (GNU/LinuxThreads) version of this package |
e6e7bf38 | 33 | |
337a9690 | 34 | -- This package contains all the GNULL primitives that interface directly with |
35 | -- the underlying OS. | |
e6e7bf38 | 36 | |
37 | pragma Polling (Off); | |
337a9690 | 38 | -- Turn off polling, we do not want ATC polling to take place during tasking |
39 | -- operations. It causes infinite loops and other problems. | |
40 | ||
e6e7bf38 | 41 | with Interfaces.C; |
e6e7bf38 | 42 | |
e2a33c18 | 43 | with System.Task_Info; |
51e69f04 | 44 | with System.Tasking.Debug; |
e6e7bf38 | 45 | with System.Interrupt_Management; |
5f02e527 | 46 | with System.OS_Constants; |
51e69f04 | 47 | with System.OS_Primitives; |
d9c927cc | 48 | with System.Multiprocessors; |
e6e7bf38 | 49 | |
51e69f04 | 50 | with System.Soft_Links; |
e0bfbf32 | 51 | -- We use System.Soft_Links instead of System.Tasking.Initialization |
52 | -- because the later is a higher level package that we shouldn't depend on. | |
53 | -- For example when using the restricted run time, it is replaced by | |
54 | -- System.Tasking.Restricted.Stages. | |
55 | ||
e6e7bf38 | 56 | package body System.Task_Primitives.Operations is |
57 | ||
5f02e527 | 58 | package OSC renames System.OS_Constants; |
e0bfbf32 | 59 | package SSL renames System.Soft_Links; |
60 | ||
e6e7bf38 | 61 | use System.Tasking.Debug; |
62 | use System.Tasking; | |
63 | use Interfaces.C; | |
64 | use System.OS_Interface; | |
65 | use System.Parameters; | |
66 | use System.OS_Primitives; | |
e2a33c18 | 67 | use System.Task_Info; |
e6e7bf38 | 68 | |
5c99c290 | 69 | ---------------- |
70 | -- Local Data -- | |
71 | ---------------- | |
e6e7bf38 | 72 | |
e6e7bf38 | 73 | -- The followings are logically constants, but need to be initialized |
74 | -- at run time. | |
75 | ||
f15731c4 | 76 | Single_RTS_Lock : aliased RTS_Lock; |
77 | -- This is a lock to allow only one thread of control in the RTS at | |
78 | -- a time; it is used to execute in mutual exclusion from all other tasks. | |
79 | -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List | |
e6e7bf38 | 80 | |
7f9be362 | 81 | Environment_Task_Id : Task_Id; |
5c99c290 | 82 | -- A variable to hold Task_Id for the environment task |
e6e7bf38 | 83 | |
84 | Unblocked_Signal_Mask : aliased sigset_t; | |
51e69f04 | 85 | -- The set of signals that should be unblocked in all tasks |
e6e7bf38 | 86 | |
5c99c290 | 87 | -- The followings are internal configuration constants needed |
88 | ||
e6e7bf38 | 89 | Next_Serial_Number : Task_Serial_Number := 100; |
887e908c | 90 | -- We start at 100 (reserve some special values for using in error checks) |
e6e7bf38 | 91 | |
92 | Time_Slice_Val : Integer; | |
93 | pragma Import (C, Time_Slice_Val, "__gl_time_slice_val"); | |
94 | ||
95 | Dispatching_Policy : Character; | |
96 | pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy"); | |
97 | ||
3812c117 | 98 | Locking_Policy : Character; |
99 | pragma Import (C, Locking_Policy, "__gl_locking_policy"); | |
100 | ||
9dfe12ae | 101 | Foreign_Task_Elaborated : aliased Boolean := True; |
5c99c290 | 102 | -- Used to identified fake tasks (i.e., non-Ada Threads) |
e6e7bf38 | 103 | |
d2cf6f2e | 104 | Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0; |
105 | -- Whether to use an alternate signal stack for stack overflows | |
106 | ||
107 | Abort_Handler_Installed : Boolean := False; | |
108 | -- True if a handler for the abort signal is installed | |
109 | ||
99f61ee1 | 110 | Null_Thread_Id : constant pthread_t := pthread_t'Last; |
111 | -- Constant to indicate that the thread identifier has not yet been | |
112 | -- initialized. | |
113 | ||
f15731c4 | 114 | -------------------- |
115 | -- Local Packages -- | |
116 | -------------------- | |
117 | ||
118 | package Specific is | |
119 | ||
7f9be362 | 120 | procedure Initialize (Environment_Task : Task_Id); |
f15731c4 | 121 | pragma Inline (Initialize); |
5c99c290 | 122 | -- Initialize various data needed by this package |
f15731c4 | 123 | |
9dfe12ae | 124 | function Is_Valid_Task return Boolean; |
125 | pragma Inline (Is_Valid_Task); | |
126 | -- Does executing thread have a TCB? | |
127 | ||
7f9be362 | 128 | procedure Set (Self_Id : Task_Id); |
f15731c4 | 129 | pragma Inline (Set); |
5c99c290 | 130 | -- Set the self id for the current task |
f15731c4 | 131 | |
7f9be362 | 132 | function Self return Task_Id; |
f15731c4 | 133 | pragma Inline (Self); |
4503aa6e | 134 | -- Return a pointer to the Ada Task Control Block of the calling task |
f15731c4 | 135 | |
136 | end Specific; | |
137 | ||
138 | package body Specific is separate; | |
5c99c290 | 139 | -- The body of this package is target specific |
f15731c4 | 140 | |
a3a76ccc | 141 | ---------------------------------- |
142 | -- ATCB allocation/deallocation -- | |
143 | ---------------------------------- | |
144 | ||
145 | package body ATCB_Allocation is separate; | |
146 | -- The body of this package is shared across several targets | |
147 | ||
9dfe12ae | 148 | --------------------------------- |
149 | -- Support for foreign threads -- | |
150 | --------------------------------- | |
151 | ||
7f9be362 | 152 | function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; |
5c99c290 | 153 | -- Allocate and Initialize a new ATCB for the current Thread |
9dfe12ae | 154 | |
155 | function Register_Foreign_Thread | |
7f9be362 | 156 | (Thread : Thread_Id) return Task_Id is separate; |
9dfe12ae | 157 | |
158 | ----------------------- | |
159 | -- Local Subprograms -- | |
160 | ----------------------- | |
161 | ||
9dfe12ae | 162 | procedure Abort_Handler (signo : Signal); |
163 | ||
e6e7bf38 | 164 | ------------------- |
165 | -- Abort_Handler -- | |
166 | ------------------- | |
167 | ||
9dfe12ae | 168 | procedure Abort_Handler (signo : Signal) is |
169 | pragma Unreferenced (signo); | |
170 | ||
7f9be362 | 171 | Self_Id : constant Task_Id := Self; |
e6e7bf38 | 172 | Result : Interfaces.C.int; |
173 | Old_Set : aliased sigset_t; | |
174 | ||
e6e7bf38 | 175 | begin |
d2cf6f2e | 176 | -- It's not safe to raise an exception when using GCC ZCX mechanism. |
177 | -- Note that we still need to install a signal handler, since in some | |
178 | -- cases (e.g. shutdown of the Server_Task in System.Interrupts) we | |
179 | -- need to send the Abort signal to a task. | |
180 | ||
3580dc54 | 181 | if ZCX_By_Default then |
9dfe12ae | 182 | return; |
183 | end if; | |
184 | ||
e6e7bf38 | 185 | if Self_Id.Deferral_Level = 0 |
186 | and then Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level | |
187 | and then not Self_Id.Aborting | |
188 | then | |
189 | Self_Id.Aborting := True; | |
190 | ||
191 | -- Make sure signals used for RTS internal purpose are unmasked | |
192 | ||
887e908c | 193 | Result := |
194 | pthread_sigmask | |
195 | (SIG_UNBLOCK, | |
682b5967 | 196 | Unblocked_Signal_Mask'Access, |
197 | Old_Set'Access); | |
e6e7bf38 | 198 | pragma Assert (Result = 0); |
199 | ||
9dfe12ae | 200 | raise Standard'Abort_Signal; |
e6e7bf38 | 201 | end if; |
202 | end Abort_Handler; | |
203 | ||
f15731c4 | 204 | -------------- |
205 | -- Lock_RTS -- | |
206 | -------------- | |
207 | ||
208 | procedure Lock_RTS is | |
209 | begin | |
210 | Write_Lock (Single_RTS_Lock'Access, Global_Lock => True); | |
211 | end Lock_RTS; | |
212 | ||
213 | ---------------- | |
214 | -- Unlock_RTS -- | |
215 | ---------------- | |
216 | ||
217 | procedure Unlock_RTS is | |
218 | begin | |
219 | Unlock (Single_RTS_Lock'Access, Global_Lock => True); | |
220 | end Unlock_RTS; | |
221 | ||
222 | ----------------- | |
223 | -- Stack_Guard -- | |
224 | ----------------- | |
e6e7bf38 | 225 | |
3670c51d | 226 | -- The underlying thread system extends the memory (up to 2MB) when needed |
e6e7bf38 | 227 | |
7f9be362 | 228 | procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is |
3670c51d | 229 | pragma Unreferenced (T); |
230 | pragma Unreferenced (On); | |
e6e7bf38 | 231 | begin |
232 | null; | |
233 | end Stack_Guard; | |
234 | ||
235 | -------------------- | |
236 | -- Get_Thread_Id -- | |
237 | -------------------- | |
238 | ||
7f9be362 | 239 | function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is |
e6e7bf38 | 240 | begin |
241 | return T.Common.LL.Thread; | |
242 | end Get_Thread_Id; | |
243 | ||
244 | ---------- | |
245 | -- Self -- | |
246 | ---------- | |
247 | ||
7f9be362 | 248 | function Self return Task_Id renames Specific.Self; |
e6e7bf38 | 249 | |
250 | --------------------- | |
251 | -- Initialize_Lock -- | |
252 | --------------------- | |
253 | ||
337a9690 | 254 | -- Note: mutexes and cond_variables needed per-task basis are initialized |
255 | -- in Initialize_TCB and the Storage_Error is handled. Other mutexes (such | |
256 | -- as RTS_Lock, Memory_Lock...) used in RTS is initialized before any | |
febb409f | 257 | -- status change of RTS. Therefore raising Storage_Error in the following |
337a9690 | 258 | -- routines should be able to be handled safely. |
e6e7bf38 | 259 | |
260 | procedure Initialize_Lock | |
261 | (Prio : System.Any_Priority; | |
99037453 | 262 | L : not null access Lock) |
e6e7bf38 | 263 | is |
51e69f04 | 264 | pragma Unreferenced (Prio); |
3670c51d | 265 | |
e6e7bf38 | 266 | begin |
3812c117 | 267 | if Locking_Policy = 'R' then |
268 | declare | |
269 | RWlock_Attr : aliased pthread_rwlockattr_t; | |
270 | Result : Interfaces.C.int; | |
423eae38 | 271 | |
3812c117 | 272 | begin |
273 | -- Set the rwlock to prefer writer to avoid writers starvation | |
e6e7bf38 | 274 | |
3812c117 | 275 | Result := pthread_rwlockattr_init (RWlock_Attr'Access); |
276 | pragma Assert (Result = 0); | |
e6e7bf38 | 277 | |
3812c117 | 278 | Result := pthread_rwlockattr_setkind_np |
279 | (RWlock_Attr'Access, | |
280 | PTHREAD_RWLOCK_PREFER_WRITER_NONRECURSIVE_NP); | |
281 | pragma Assert (Result = 0); | |
e6e7bf38 | 282 | |
3812c117 | 283 | Result := pthread_rwlock_init (L.RW'Access, RWlock_Attr'Access); |
c5bd7839 | 284 | |
3812c117 | 285 | pragma Assert (Result = 0 or else Result = ENOMEM); |
c5bd7839 | 286 | |
3812c117 | 287 | if Result = ENOMEM then |
288 | raise Storage_Error with "Failed to allocate a lock"; | |
289 | end if; | |
290 | end; | |
c5bd7839 | 291 | |
3812c117 | 292 | else |
293 | declare | |
18a02da2 | 294 | Result : Interfaces.C.int; |
c5bd7839 | 295 | |
3812c117 | 296 | begin |
18a02da2 | 297 | Result := pthread_mutex_init (L.WO'Access, null); |
c5bd7839 | 298 | |
3812c117 | 299 | pragma Assert (Result = 0 or else Result = ENOMEM); |
c5bd7839 | 300 | |
3812c117 | 301 | if Result = ENOMEM then |
302 | raise Storage_Error with "Failed to allocate a lock"; | |
303 | end if; | |
304 | end; | |
c5bd7839 | 305 | end if; |
306 | end Initialize_Lock; | |
307 | ||
99037453 | 308 | procedure Initialize_Lock |
887e908c | 309 | (L : not null access RTS_Lock; |
310 | Level : Lock_Level) | |
99037453 | 311 | is |
3670c51d | 312 | pragma Unreferenced (Level); |
313 | ||
18a02da2 | 314 | Result : Interfaces.C.int; |
e6e7bf38 | 315 | |
316 | begin | |
18a02da2 | 317 | Result := pthread_mutex_init (L, null); |
e6e7bf38 | 318 | |
319 | pragma Assert (Result = 0 or else Result = ENOMEM); | |
320 | ||
321 | if Result = ENOMEM then | |
322 | raise Storage_Error; | |
323 | end if; | |
324 | end Initialize_Lock; | |
325 | ||
326 | ------------------- | |
327 | -- Finalize_Lock -- | |
328 | ------------------- | |
329 | ||
99037453 | 330 | procedure Finalize_Lock (L : not null access Lock) is |
e6e7bf38 | 331 | Result : Interfaces.C.int; |
e6e7bf38 | 332 | begin |
3812c117 | 333 | if Locking_Policy = 'R' then |
334 | Result := pthread_rwlock_destroy (L.RW'Access); | |
335 | else | |
336 | Result := pthread_mutex_destroy (L.WO'Access); | |
337 | end if; | |
c5bd7839 | 338 | pragma Assert (Result = 0); |
339 | end Finalize_Lock; | |
340 | ||
99037453 | 341 | procedure Finalize_Lock (L : not null access RTS_Lock) is |
e6e7bf38 | 342 | Result : Interfaces.C.int; |
e6e7bf38 | 343 | begin |
344 | Result := pthread_mutex_destroy (L); | |
345 | pragma Assert (Result = 0); | |
346 | end Finalize_Lock; | |
347 | ||
348 | ---------------- | |
349 | -- Write_Lock -- | |
350 | ---------------- | |
351 | ||
99037453 | 352 | procedure Write_Lock |
887e908c | 353 | (L : not null access Lock; |
354 | Ceiling_Violation : out Boolean) | |
99037453 | 355 | is |
e6e7bf38 | 356 | Result : Interfaces.C.int; |
e6e7bf38 | 357 | begin |
3812c117 | 358 | if Locking_Policy = 'R' then |
359 | Result := pthread_rwlock_wrlock (L.RW'Access); | |
360 | else | |
361 | Result := pthread_mutex_lock (L.WO'Access); | |
362 | end if; | |
e6e7bf38 | 363 | |
c5bd7839 | 364 | Ceiling_Violation := Result = EINVAL; |
365 | ||
366 | -- Assume the cause of EINVAL is a priority ceiling violation | |
367 | ||
368 | pragma Assert (Result = 0 or else Result = EINVAL); | |
369 | end Write_Lock; | |
370 | ||
f15731c4 | 371 | procedure Write_Lock |
99037453 | 372 | (L : not null access RTS_Lock; |
3670c51d | 373 | Global_Lock : Boolean := False) |
f15731c4 | 374 | is |
e6e7bf38 | 375 | Result : Interfaces.C.int; |
e6e7bf38 | 376 | begin |
f15731c4 | 377 | if not Single_Lock or else Global_Lock then |
378 | Result := pthread_mutex_lock (L); | |
379 | pragma Assert (Result = 0); | |
380 | end if; | |
e6e7bf38 | 381 | end Write_Lock; |
382 | ||
7f9be362 | 383 | procedure Write_Lock (T : Task_Id) is |
e6e7bf38 | 384 | Result : Interfaces.C.int; |
e6e7bf38 | 385 | begin |
f15731c4 | 386 | if not Single_Lock then |
387 | Result := pthread_mutex_lock (T.Common.LL.L'Access); | |
388 | pragma Assert (Result = 0); | |
389 | end if; | |
e6e7bf38 | 390 | end Write_Lock; |
391 | ||
392 | --------------- | |
393 | -- Read_Lock -- | |
394 | --------------- | |
395 | ||
99037453 | 396 | procedure Read_Lock |
3812c117 | 397 | (L : not null access Lock; |
887e908c | 398 | Ceiling_Violation : out Boolean) |
399 | is | |
c5bd7839 | 400 | Result : Interfaces.C.int; |
e6e7bf38 | 401 | begin |
3812c117 | 402 | if Locking_Policy = 'R' then |
403 | Result := pthread_rwlock_rdlock (L.RW'Access); | |
404 | else | |
405 | Result := pthread_mutex_lock (L.WO'Access); | |
406 | end if; | |
407 | ||
c5bd7839 | 408 | Ceiling_Violation := Result = EINVAL; |
409 | ||
410 | -- Assume the cause of EINVAL is a priority ceiling violation | |
411 | ||
412 | pragma Assert (Result = 0 or else Result = EINVAL); | |
e6e7bf38 | 413 | end Read_Lock; |
414 | ||
415 | ------------ | |
416 | -- Unlock -- | |
417 | ------------ | |
418 | ||
99037453 | 419 | procedure Unlock (L : not null access Lock) is |
e6e7bf38 | 420 | Result : Interfaces.C.int; |
e6e7bf38 | 421 | begin |
3812c117 | 422 | if Locking_Policy = 'R' then |
423 | Result := pthread_rwlock_unlock (L.RW'Access); | |
424 | else | |
425 | Result := pthread_mutex_unlock (L.WO'Access); | |
426 | end if; | |
c5bd7839 | 427 | pragma Assert (Result = 0); |
428 | end Unlock; | |
429 | ||
99037453 | 430 | procedure Unlock |
887e908c | 431 | (L : not null access RTS_Lock; |
432 | Global_Lock : Boolean := False) | |
99037453 | 433 | is |
e6e7bf38 | 434 | Result : Interfaces.C.int; |
e6e7bf38 | 435 | begin |
f15731c4 | 436 | if not Single_Lock or else Global_Lock then |
437 | Result := pthread_mutex_unlock (L); | |
438 | pragma Assert (Result = 0); | |
439 | end if; | |
e6e7bf38 | 440 | end Unlock; |
441 | ||
7f9be362 | 442 | procedure Unlock (T : Task_Id) is |
e6e7bf38 | 443 | Result : Interfaces.C.int; |
e6e7bf38 | 444 | begin |
f15731c4 | 445 | if not Single_Lock then |
446 | Result := pthread_mutex_unlock (T.Common.LL.L'Access); | |
447 | pragma Assert (Result = 0); | |
448 | end if; | |
e6e7bf38 | 449 | end Unlock; |
450 | ||
887e908c | 451 | ----------------- |
452 | -- Set_Ceiling -- | |
453 | ----------------- | |
454 | ||
455 | -- Dynamic priority ceilings are not supported by the underlying system | |
456 | ||
457 | procedure Set_Ceiling | |
458 | (L : not null access Lock; | |
459 | Prio : System.Any_Priority) | |
460 | is | |
461 | pragma Unreferenced (L, Prio); | |
462 | begin | |
463 | null; | |
464 | end Set_Ceiling; | |
465 | ||
f15731c4 | 466 | ----------- |
467 | -- Sleep -- | |
468 | ----------- | |
e6e7bf38 | 469 | |
f15731c4 | 470 | procedure Sleep |
7f9be362 | 471 | (Self_ID : Task_Id; |
f15731c4 | 472 | Reason : System.Tasking.Task_States) |
473 | is | |
3670c51d | 474 | pragma Unreferenced (Reason); |
475 | ||
e6e7bf38 | 476 | Result : Interfaces.C.int; |
3670c51d | 477 | |
e6e7bf38 | 478 | begin |
479 | pragma Assert (Self_ID = Self); | |
f15731c4 | 480 | |
04409526 | 481 | Result := |
482 | pthread_cond_wait | |
483 | (cond => Self_ID.Common.LL.CV'Access, | |
484 | mutex => (if Single_Lock | |
485 | then Single_RTS_Lock'Access | |
486 | else Self_ID.Common.LL.L'Access)); | |
f15731c4 | 487 | |
5c99c290 | 488 | -- EINTR is not considered a failure |
489 | ||
e6e7bf38 | 490 | pragma Assert (Result = 0 or else Result = EINTR); |
491 | end Sleep; | |
492 | ||
493 | ----------------- | |
494 | -- Timed_Sleep -- | |
495 | ----------------- | |
496 | ||
497 | -- This is for use within the run-time system, so abort is | |
498 | -- assumed to be already deferred, and the caller should be | |
499 | -- holding its own ATCB lock. | |
500 | ||
501 | procedure Timed_Sleep | |
7f9be362 | 502 | (Self_ID : Task_Id; |
e6e7bf38 | 503 | Time : Duration; |
504 | Mode : ST.Delay_Modes; | |
505 | Reason : System.Tasking.Task_States; | |
506 | Timedout : out Boolean; | |
507 | Yielded : out Boolean) | |
508 | is | |
3670c51d | 509 | pragma Unreferenced (Reason); |
510 | ||
887e908c | 511 | Base_Time : constant Duration := Monotonic_Clock; |
512 | Check_Time : Duration := Base_Time; | |
e6e7bf38 | 513 | Abs_Time : Duration; |
514 | Request : aliased timespec; | |
515 | Result : Interfaces.C.int; | |
3670c51d | 516 | |
e6e7bf38 | 517 | begin |
518 | Timedout := True; | |
519 | Yielded := False; | |
520 | ||
04409526 | 521 | Abs_Time := |
522 | (if Mode = Relative | |
523 | then Duration'Min (Time, Max_Sensible_Delay) + Check_Time | |
524 | else Duration'Min (Check_Time + Max_Sensible_Delay, Time)); | |
e6e7bf38 | 525 | |
526 | if Abs_Time > Check_Time then | |
527 | Request := To_Timespec (Abs_Time); | |
528 | ||
529 | loop | |
887e908c | 530 | exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level; |
e6e7bf38 | 531 | |
04409526 | 532 | Result := |
533 | pthread_cond_timedwait | |
534 | (cond => Self_ID.Common.LL.CV'Access, | |
535 | mutex => (if Single_Lock | |
536 | then Single_RTS_Lock'Access | |
537 | else Self_ID.Common.LL.L'Access), | |
538 | abstime => Request'Access); | |
e6e7bf38 | 539 | |
887e908c | 540 | Check_Time := Monotonic_Clock; |
541 | exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; | |
542 | ||
543 | if Result = 0 or else Result = EINTR then | |
544 | ||
545 | -- Somebody may have called Wakeup for us | |
e6e7bf38 | 546 | |
e6e7bf38 | 547 | Timedout := False; |
548 | exit; | |
549 | end if; | |
550 | ||
551 | pragma Assert (Result = ETIMEDOUT); | |
552 | end loop; | |
553 | end if; | |
554 | end Timed_Sleep; | |
555 | ||
556 | ----------------- | |
557 | -- Timed_Delay -- | |
558 | ----------------- | |
559 | ||
887e908c | 560 | -- This is for use in implementing delay statements, so we assume the |
561 | -- caller is abort-deferred but is holding no locks. | |
e6e7bf38 | 562 | |
563 | procedure Timed_Delay | |
4503aa6e | 564 | (Self_ID : Task_Id; |
565 | Time : Duration; | |
566 | Mode : ST.Delay_Modes) | |
e6e7bf38 | 567 | is |
887e908c | 568 | Base_Time : constant Duration := Monotonic_Clock; |
569 | Check_Time : Duration := Base_Time; | |
e6e7bf38 | 570 | Abs_Time : Duration; |
571 | Request : aliased timespec; | |
4503aa6e | 572 | |
573 | Result : Interfaces.C.int; | |
574 | pragma Warnings (Off, Result); | |
f15731c4 | 575 | |
51e69f04 | 576 | begin |
f15731c4 | 577 | if Single_Lock then |
578 | Lock_RTS; | |
579 | end if; | |
580 | ||
e6e7bf38 | 581 | Write_Lock (Self_ID); |
582 | ||
04409526 | 583 | Abs_Time := |
584 | (if Mode = Relative | |
585 | then Time + Check_Time | |
586 | else Duration'Min (Check_Time + Max_Sensible_Delay, Time)); | |
e6e7bf38 | 587 | |
588 | if Abs_Time > Check_Time then | |
589 | Request := To_Timespec (Abs_Time); | |
590 | Self_ID.Common.State := Delay_Sleep; | |
591 | ||
592 | loop | |
e6e7bf38 | 593 | exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level; |
594 | ||
04409526 | 595 | Result := |
596 | pthread_cond_timedwait | |
597 | (cond => Self_ID.Common.LL.CV'Access, | |
598 | mutex => (if Single_Lock | |
599 | then Single_RTS_Lock'Access | |
600 | else Self_ID.Common.LL.L'Access), | |
601 | abstime => Request'Access); | |
e6e7bf38 | 602 | |
887e908c | 603 | Check_Time := Monotonic_Clock; |
604 | exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; | |
e6e7bf38 | 605 | |
606 | pragma Assert (Result = 0 or else | |
607 | Result = ETIMEDOUT or else | |
608 | Result = EINTR); | |
609 | end loop; | |
610 | ||
611 | Self_ID.Common.State := Runnable; | |
612 | end if; | |
613 | ||
614 | Unlock (Self_ID); | |
f15731c4 | 615 | |
616 | if Single_Lock then | |
617 | Unlock_RTS; | |
618 | end if; | |
619 | ||
e6e7bf38 | 620 | Result := sched_yield; |
e6e7bf38 | 621 | end Timed_Delay; |
622 | ||
623 | --------------------- | |
624 | -- Monotonic_Clock -- | |
625 | --------------------- | |
626 | ||
627 | function Monotonic_Clock return Duration is | |
4f6fa17d | 628 | TS : aliased timespec; |
2333d20b | 629 | Result : int; |
e6e7bf38 | 630 | begin |
4f6fa17d | 631 | Result := clock_gettime |
632 | (clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access); | |
e6e7bf38 | 633 | pragma Assert (Result = 0); |
4f6fa17d | 634 | |
635 | return To_Duration (TS); | |
e6e7bf38 | 636 | end Monotonic_Clock; |
637 | ||
638 | ------------------- | |
639 | -- RT_Resolution -- | |
640 | ------------------- | |
641 | ||
642 | function RT_Resolution return Duration is | |
5f02e527 | 643 | TS : aliased timespec; |
644 | Result : int; | |
e2c7aa50 | 645 | |
e6e7bf38 | 646 | begin |
5f02e527 | 647 | Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access); |
648 | pragma Assert (Result = 0); | |
649 | ||
650 | return To_Duration (TS); | |
e6e7bf38 | 651 | end RT_Resolution; |
652 | ||
653 | ------------ | |
654 | -- Wakeup -- | |
655 | ------------ | |
656 | ||
7f9be362 | 657 | procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is |
3670c51d | 658 | pragma Unreferenced (Reason); |
e6e7bf38 | 659 | Result : Interfaces.C.int; |
e6e7bf38 | 660 | begin |
661 | Result := pthread_cond_signal (T.Common.LL.CV'Access); | |
662 | pragma Assert (Result = 0); | |
663 | end Wakeup; | |
664 | ||
665 | ----------- | |
666 | -- Yield -- | |
667 | ----------- | |
668 | ||
669 | procedure Yield (Do_Yield : Boolean := True) is | |
670 | Result : Interfaces.C.int; | |
9dfe12ae | 671 | pragma Unreferenced (Result); |
e6e7bf38 | 672 | begin |
673 | if Do_Yield then | |
674 | Result := sched_yield; | |
675 | end if; | |
676 | end Yield; | |
677 | ||
678 | ------------------ | |
679 | -- Set_Priority -- | |
680 | ------------------ | |
681 | ||
682 | procedure Set_Priority | |
7f9be362 | 683 | (T : Task_Id; |
3670c51d | 684 | Prio : System.Any_Priority; |
e6e7bf38 | 685 | Loss_Of_Inheritance : Boolean := False) |
686 | is | |
3670c51d | 687 | pragma Unreferenced (Loss_Of_Inheritance); |
688 | ||
e6e7bf38 | 689 | Result : Interfaces.C.int; |
690 | Param : aliased struct_sched_param; | |
691 | ||
4503aa6e | 692 | function Get_Policy (Prio : System.Any_Priority) return Character; |
693 | pragma Import (C, Get_Policy, "__gnat_get_specific_dispatching"); | |
694 | -- Get priority specific dispatching policy | |
695 | ||
696 | Priority_Specific_Policy : constant Character := Get_Policy (Prio); | |
697 | -- Upper case first character of the policy name corresponding to the | |
698 | -- task as set by a Priority_Specific_Dispatching pragma. | |
699 | ||
e6e7bf38 | 700 | begin |
701 | T.Common.Current_Priority := Prio; | |
702 | ||
887e908c | 703 | -- Priorities are 1 .. 99 on GNU/Linux, so we map 0 .. 98 to 1 .. 99 |
f9c9d5d3 | 704 | |
e6e7bf38 | 705 | Param.sched_priority := Interfaces.C.int (Prio) + 1; |
706 | ||
4503aa6e | 707 | if Dispatching_Policy = 'R' |
708 | or else Priority_Specific_Policy = 'R' | |
709 | or else Time_Slice_Val > 0 | |
710 | then | |
887e908c | 711 | Result := |
712 | pthread_setschedparam | |
713 | (T.Common.LL.Thread, SCHED_RR, Param'Access); | |
e6e7bf38 | 714 | |
4503aa6e | 715 | elsif Dispatching_Policy = 'F' |
716 | or else Priority_Specific_Policy = 'F' | |
717 | or else Time_Slice_Val = 0 | |
718 | then | |
887e908c | 719 | Result := |
720 | pthread_setschedparam | |
721 | (T.Common.LL.Thread, SCHED_FIFO, Param'Access); | |
e6e7bf38 | 722 | |
723 | else | |
d5b349fa | 724 | Param.sched_priority := 0; |
887e908c | 725 | Result := |
726 | pthread_setschedparam | |
727 | (T.Common.LL.Thread, | |
728 | SCHED_OTHER, Param'Access); | |
e6e7bf38 | 729 | end if; |
730 | ||
731 | pragma Assert (Result = 0 or else Result = EPERM); | |
732 | end Set_Priority; | |
733 | ||
734 | ------------------ | |
735 | -- Get_Priority -- | |
736 | ------------------ | |
737 | ||
7f9be362 | 738 | function Get_Priority (T : Task_Id) return System.Any_Priority is |
e6e7bf38 | 739 | begin |
740 | return T.Common.Current_Priority; | |
741 | end Get_Priority; | |
742 | ||
743 | ---------------- | |
744 | -- Enter_Task -- | |
745 | ---------------- | |
746 | ||
7f9be362 | 747 | procedure Enter_Task (Self_ID : Task_Id) is |
e6e7bf38 | 748 | begin |
e2a33c18 | 749 | if Self_ID.Common.Task_Info /= null |
0244eba9 | 750 | and then Self_ID.Common.Task_Info.CPU_Affinity = No_CPU |
e2a33c18 | 751 | then |
752 | raise Invalid_CPU_Number; | |
753 | end if; | |
754 | ||
e6e7bf38 | 755 | Self_ID.Common.LL.Thread := pthread_self; |
a0d9619f | 756 | Self_ID.Common.LL.LWP := lwp_self; |
e6e7bf38 | 757 | |
72f889fa | 758 | -- Set thread name to ease debugging. If the name of the task is |
759 | -- "foreign thread" (as set by Register_Foreign_Thread) retrieve | |
760 | -- the name of the thread and update the name of the task instead. | |
761 | ||
762 | if Self_ID.Common.Task_Image_Len = 14 | |
763 | and then Self_ID.Common.Task_Image (1 .. 14) = "foreign thread" | |
764 | then | |
765 | declare | |
766 | Thread_Name : String (1 .. 16); | |
767 | -- PR_GET_NAME returns a string of up to 16 bytes | |
768 | ||
769 | Len : Natural := 0; | |
770 | -- Length of the task name contained in Task_Name | |
771 | ||
772 | Result : int; | |
773 | -- Result from the prctl call | |
774 | begin | |
775 | Result := prctl (PR_GET_NAME, unsigned_long (Thread_Name'Address)); | |
776 | pragma Assert (Result = 0); | |
777 | ||
778 | -- Find the length of the given name | |
779 | ||
780 | for J in Thread_Name'Range loop | |
781 | if Thread_Name (J) /= ASCII.NUL then | |
782 | Len := Len + 1; | |
783 | else | |
784 | exit; | |
785 | end if; | |
786 | end loop; | |
787 | ||
788 | -- Cover the odd situtation if someone decides to change | |
789 | -- Parameters.Max_Task_Image_Length to less than 16 characters | |
790 | ||
791 | if Len > Parameters.Max_Task_Image_Length then | |
792 | Len := Parameters.Max_Task_Image_Length; | |
793 | end if; | |
794 | ||
795 | -- Copy the name of the thread to the task's ATCB | |
796 | ||
797 | Self_ID.Common.Task_Image (1 .. Len) := Thread_Name (1 .. Len); | |
798 | Self_ID.Common.Task_Image_Len := Len; | |
799 | end; | |
800 | ||
801 | elsif Self_ID.Common.Task_Image_Len > 0 then | |
019bce56 | 802 | declare |
803 | Task_Name : String (1 .. Parameters.Max_Task_Image_Length + 1); | |
804 | Result : int; | |
385d80fe | 805 | |
019bce56 | 806 | begin |
019bce56 | 807 | Task_Name (1 .. Self_ID.Common.Task_Image_Len) := |
808 | Self_ID.Common.Task_Image (1 .. Self_ID.Common.Task_Image_Len); | |
809 | Task_Name (Self_ID.Common.Task_Image_Len + 1) := ASCII.NUL; | |
810 | ||
811 | Result := prctl (PR_SET_NAME, unsigned_long (Task_Name'Address)); | |
812 | pragma Assert (Result = 0); | |
813 | end; | |
814 | end if; | |
815 | ||
f15731c4 | 816 | Specific.Set (Self_ID); |
e6e7bf38 | 817 | |
784d4230 | 818 | if Use_Alternate_Stack |
819 | and then Self_ID.Common.Task_Alternate_Stack /= Null_Address | |
820 | then | |
0244eba9 | 821 | declare |
822 | Stack : aliased stack_t; | |
823 | Result : Interfaces.C.int; | |
824 | begin | |
825 | Stack.ss_sp := Self_ID.Common.Task_Alternate_Stack; | |
826 | Stack.ss_size := Alternate_Stack_Size; | |
827 | Stack.ss_flags := 0; | |
828 | Result := sigaltstack (Stack'Access, null); | |
829 | pragma Assert (Result = 0); | |
830 | end; | |
831 | end if; | |
e6e7bf38 | 832 | end Enter_Task; |
833 | ||
9dfe12ae | 834 | ------------------- |
835 | -- Is_Valid_Task -- | |
836 | ------------------- | |
837 | ||
838 | function Is_Valid_Task return Boolean renames Specific.Is_Valid_Task; | |
839 | ||
840 | ----------------------------- | |
841 | -- Register_Foreign_Thread -- | |
842 | ----------------------------- | |
843 | ||
7f9be362 | 844 | function Register_Foreign_Thread return Task_Id is |
9dfe12ae | 845 | begin |
846 | if Is_Valid_Task then | |
847 | return Self; | |
848 | else | |
849 | return Register_Foreign_Thread (pthread_self); | |
850 | end if; | |
851 | end Register_Foreign_Thread; | |
852 | ||
e6e7bf38 | 853 | -------------------- |
854 | -- Initialize_TCB -- | |
855 | -------------------- | |
856 | ||
7f9be362 | 857 | procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is |
18a02da2 | 858 | Cond_Attr : aliased pthread_condattr_t; |
859 | Result : Interfaces.C.int; | |
e6e7bf38 | 860 | |
861 | begin | |
5c99c290 | 862 | -- Give the task a unique serial number |
e6e7bf38 | 863 | |
864 | Self_ID.Serial_Number := Next_Serial_Number; | |
865 | Next_Serial_Number := Next_Serial_Number + 1; | |
866 | pragma Assert (Next_Serial_Number /= 0); | |
867 | ||
99f61ee1 | 868 | Self_ID.Common.LL.Thread := Null_Thread_Id; |
e6e7bf38 | 869 | |
f15731c4 | 870 | if not Single_Lock then |
449c4810 | 871 | Result := |
18a02da2 | 872 | pthread_mutex_init (Self_ID.Common.LL.L'Access, null); |
f15731c4 | 873 | pragma Assert (Result = 0 or else Result = ENOMEM); |
e6e7bf38 | 874 | |
f15731c4 | 875 | if Result /= 0 then |
876 | Succeeded := False; | |
877 | return; | |
878 | end if; | |
e6e7bf38 | 879 | end if; |
880 | ||
423eae38 | 881 | Result := pthread_condattr_init (Cond_Attr'Access); |
882 | pragma Assert (Result = 0); | |
883 | ||
449c4810 | 884 | Result := |
885 | pthread_cond_init (Self_ID.Common.LL.CV'Access, Cond_Attr'Access); | |
e6e7bf38 | 886 | pragma Assert (Result = 0 or else Result = ENOMEM); |
887 | ||
888 | if Result = 0 then | |
889 | Succeeded := True; | |
890 | else | |
f15731c4 | 891 | if not Single_Lock then |
892 | Result := pthread_mutex_destroy (Self_ID.Common.LL.L'Access); | |
893 | pragma Assert (Result = 0); | |
894 | end if; | |
895 | ||
e6e7bf38 | 896 | Succeeded := False; |
897 | end if; | |
e6e7bf38 | 898 | end Initialize_TCB; |
899 | ||
900 | ----------------- | |
901 | -- Create_Task -- | |
902 | ----------------- | |
903 | ||
904 | procedure Create_Task | |
7f9be362 | 905 | (T : Task_Id; |
e6e7bf38 | 906 | Wrapper : System.Address; |
907 | Stack_Size : System.Parameters.Size_Type; | |
908 | Priority : System.Any_Priority; | |
909 | Succeeded : out Boolean) | |
910 | is | |
0244eba9 | 911 | Attributes : aliased pthread_attr_t; |
912 | Adjusted_Stack_Size : Interfaces.C.size_t; | |
913 | Result : Interfaces.C.int; | |
e6e7bf38 | 914 | |
d9c927cc | 915 | use type System.Multiprocessors.CPU_Range; |
916 | ||
e6e7bf38 | 917 | begin |
449c4810 | 918 | -- Check whether both Dispatching_Domain and CPU are specified for |
919 | -- the task, and the CPU value is not contained within the range of | |
a7a4a7c2 | 920 | -- processors for the domain. |
921 | ||
e7b8f0ea | 922 | if T.Common.Domain /= null |
923 | and then T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU | |
924 | and then | |
925 | (T.Common.Base_CPU not in T.Common.Domain'Range | |
926 | or else not T.Common.Domain (T.Common.Base_CPU)) | |
a7a4a7c2 | 927 | then |
928 | Succeeded := False; | |
929 | return; | |
930 | end if; | |
931 | ||
0244eba9 | 932 | Adjusted_Stack_Size := |
933 | Interfaces.C.size_t (Stack_Size + Alternate_Stack_Size); | |
934 | ||
e6e7bf38 | 935 | Result := pthread_attr_init (Attributes'Access); |
936 | pragma Assert (Result = 0 or else Result = ENOMEM); | |
937 | ||
9dfe12ae | 938 | if Result /= 0 then |
e6e7bf38 | 939 | Succeeded := False; |
940 | return; | |
941 | end if; | |
942 | ||
9dfe12ae | 943 | Result := |
449c4810 | 944 | pthread_attr_setstacksize (Attributes'Access, Adjusted_Stack_Size); |
9dfe12ae | 945 | pragma Assert (Result = 0); |
946 | ||
947 | Result := | |
948 | pthread_attr_setdetachstate | |
949 | (Attributes'Access, PTHREAD_CREATE_DETACHED); | |
e6e7bf38 | 950 | pragma Assert (Result = 0); |
951 | ||
4350bdfb | 952 | -- Set the required attributes for the creation of the thread |
d9c927cc | 953 | |
4350bdfb | 954 | -- Note: Previously, we called pthread_setaffinity_np (after thread |
955 | -- creation but before thread activation) to set the affinity but it was | |
956 | -- not behaving as expected. Setting the required attributes for the | |
957 | -- creation of the thread works correctly and it is more appropriate. | |
38e26a05 | 958 | |
aaaf92e8 | 959 | -- Do nothing if required support not provided by the operating system |
960 | ||
961 | if pthread_attr_setaffinity_np'Address = System.Null_Address then | |
962 | null; | |
963 | ||
964 | -- Support is available | |
965 | ||
966 | elsif T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then | |
d9c927cc | 967 | declare |
91965b95 | 968 | CPUs : constant size_t := |
38846e90 | 969 | Interfaces.C.size_t |
970 | (System.Multiprocessors.Number_Of_CPUs); | |
91965b95 | 971 | CPU_Set : constant cpu_set_t_ptr := CPU_ALLOC (CPUs); |
972 | Size : constant size_t := CPU_ALLOC_SIZE (CPUs); | |
40d4441d | 973 | |
d9c927cc | 974 | begin |
91965b95 | 975 | CPU_ZERO (Size, CPU_Set); |
40d4441d | 976 | System.OS_Interface.CPU_SET |
91965b95 | 977 | (int (T.Common.Base_CPU), Size, CPU_Set); |
d9c927cc | 978 | Result := |
91965b95 | 979 | pthread_attr_setaffinity_np (Attributes'Access, Size, CPU_Set); |
d9c927cc | 980 | pragma Assert (Result = 0); |
91965b95 | 981 | |
982 | CPU_FREE (CPU_Set); | |
d9c927cc | 983 | end; |
984 | ||
985 | -- Handle Task_Info | |
986 | ||
91965b95 | 987 | elsif T.Common.Task_Info /= null then |
d9c927cc | 988 | Result := |
989 | pthread_attr_setaffinity_np | |
990 | (Attributes'Access, | |
991 | CPU_SETSIZE / 8, | |
992 | T.Common.Task_Info.CPU_Affinity'Access); | |
993 | pragma Assert (Result = 0); | |
3157c4f3 | 994 | |
995 | -- Handle dispatching domains | |
996 | ||
6854063c | 997 | -- To avoid changing CPU affinities when not needed, we set the |
998 | -- affinity only when assigning to a domain other than the default | |
999 | -- one, or when the default one has been modified. | |
1000 | ||
1001 | elsif T.Common.Domain /= null and then | |
1002 | (T.Common.Domain /= ST.System_Domain | |
1003 | or else T.Common.Domain.all /= | |
1004 | (Multiprocessors.CPU'First .. | |
1005 | Multiprocessors.Number_Of_CPUs => True)) | |
1006 | then | |
3157c4f3 | 1007 | declare |
91965b95 | 1008 | CPUs : constant size_t := |
38846e90 | 1009 | Interfaces.C.size_t |
1010 | (System.Multiprocessors.Number_Of_CPUs); | |
91965b95 | 1011 | CPU_Set : constant cpu_set_t_ptr := CPU_ALLOC (CPUs); |
1012 | Size : constant size_t := CPU_ALLOC_SIZE (CPUs); | |
83a0ab2a | 1013 | |
3157c4f3 | 1014 | begin |
91965b95 | 1015 | CPU_ZERO (Size, CPU_Set); |
40d4441d | 1016 | |
3157c4f3 | 1017 | -- Set the affinity to all the processors belonging to the |
1018 | -- dispatching domain. | |
1019 | ||
1020 | for Proc in T.Common.Domain'Range loop | |
40d4441d | 1021 | if T.Common.Domain (Proc) then |
91965b95 | 1022 | System.OS_Interface.CPU_SET (int (Proc), Size, CPU_Set); |
40d4441d | 1023 | end if; |
3157c4f3 | 1024 | end loop; |
1025 | ||
1026 | Result := | |
91965b95 | 1027 | pthread_attr_setaffinity_np (Attributes'Access, Size, CPU_Set); |
3157c4f3 | 1028 | pragma Assert (Result = 0); |
91965b95 | 1029 | |
1030 | CPU_FREE (CPU_Set); | |
3157c4f3 | 1031 | end; |
d9c927cc | 1032 | end if; |
1033 | ||
e6e7bf38 | 1034 | -- Since the initial signal mask of a thread is inherited from the |
1035 | -- creator, and the Environment task has all its signals masked, we | |
1036 | -- do not need to manipulate caller's signal mask at this point. | |
1037 | -- All tasks in RTS will have All_Tasks_Mask initially. | |
1038 | ||
6dbcfcd9 | 1039 | -- Note: the use of Unrestricted_Access in the following call is needed |
1040 | -- because otherwise we have an error of getting a access-to-volatile | |
1041 | -- value which points to a non-volatile object. But in this case it is | |
1042 | -- safe to do this, since we know we have no problems with aliasing and | |
1043 | -- Unrestricted_Access bypasses this check. | |
1044 | ||
1045 | Result := | |
1046 | pthread_create | |
1047 | (T.Common.LL.Thread'Unrestricted_Access, | |
1048 | Attributes'Access, | |
1049 | Thread_Body_Access (Wrapper), | |
1050 | To_Address (T)); | |
38846e90 | 1051 | |
0244eba9 | 1052 | pragma Assert |
1053 | (Result = 0 or else Result = EAGAIN or else Result = ENOMEM); | |
e6e7bf38 | 1054 | |
337a9690 | 1055 | if Result /= 0 then |
1056 | Succeeded := False; | |
1057 | Result := pthread_attr_destroy (Attributes'Access); | |
1058 | pragma Assert (Result = 0); | |
1059 | return; | |
1060 | end if; | |
1061 | ||
1062 | Succeeded := True; | |
e6e7bf38 | 1063 | |
1064 | Result := pthread_attr_destroy (Attributes'Access); | |
1065 | pragma Assert (Result = 0); | |
1066 | ||
1067 | Set_Priority (T, Priority); | |
1068 | end Create_Task; | |
1069 | ||
1070 | ------------------ | |
1071 | -- Finalize_TCB -- | |
1072 | ------------------ | |
1073 | ||
7f9be362 | 1074 | procedure Finalize_TCB (T : Task_Id) is |
a3a76ccc | 1075 | Result : Interfaces.C.int; |
e6e7bf38 | 1076 | |
1077 | begin | |
f15731c4 | 1078 | if not Single_Lock then |
1079 | Result := pthread_mutex_destroy (T.Common.LL.L'Access); | |
1080 | pragma Assert (Result = 0); | |
1081 | end if; | |
1082 | ||
e6e7bf38 | 1083 | Result := pthread_cond_destroy (T.Common.LL.CV'Access); |
1084 | pragma Assert (Result = 0); | |
f15731c4 | 1085 | |
e6e7bf38 | 1086 | if T.Known_Tasks_Index /= -1 then |
1087 | Known_Tasks (T.Known_Tasks_Index) := null; | |
1088 | end if; | |
38846e90 | 1089 | |
a3a76ccc | 1090 | ATCB_Allocation.Free_ATCB (T); |
e6e7bf38 | 1091 | end Finalize_TCB; |
1092 | ||
1093 | --------------- | |
1094 | -- Exit_Task -- | |
1095 | --------------- | |
1096 | ||
1097 | procedure Exit_Task is | |
1098 | begin | |
9dfe12ae | 1099 | Specific.Set (null); |
e6e7bf38 | 1100 | end Exit_Task; |
1101 | ||
1102 | ---------------- | |
1103 | -- Abort_Task -- | |
1104 | ---------------- | |
1105 | ||
7f9be362 | 1106 | procedure Abort_Task (T : Task_Id) is |
e6e7bf38 | 1107 | Result : Interfaces.C.int; |
a51d0b73 | 1108 | |
1109 | ESRCH : constant := 3; -- No such process | |
27c92dd1 | 1110 | -- It can happen that T has already vanished, in which case pthread_kill |
1111 | -- returns ESRCH, so we don't consider that to be an error. | |
a51d0b73 | 1112 | |
e6e7bf38 | 1113 | begin |
d2cf6f2e | 1114 | if Abort_Handler_Installed then |
1115 | Result := | |
1116 | pthread_kill | |
1117 | (T.Common.LL.Thread, | |
1118 | Signal (System.Interrupt_Management.Abort_Task_Interrupt)); | |
27c92dd1 | 1119 | pragma Assert (Result = 0 or else Result = ESRCH); |
d2cf6f2e | 1120 | end if; |
e6e7bf38 | 1121 | end Abort_Task; |
1122 | ||
96d7aa32 | 1123 | ---------------- |
1124 | -- Initialize -- | |
1125 | ---------------- | |
1126 | ||
1127 | procedure Initialize (S : in out Suspension_Object) is | |
71e2a248 | 1128 | Result : Interfaces.C.int; |
887e908c | 1129 | |
96d7aa32 | 1130 | begin |
887e908c | 1131 | -- Initialize internal state (always to False (RM D.10(6))) |
96d7aa32 | 1132 | |
1133 | S.State := False; | |
1134 | S.Waiting := False; | |
1135 | ||
1136 | -- Initialize internal mutex | |
1137 | ||
18a02da2 | 1138 | Result := pthread_mutex_init (S.L'Access, null); |
96d7aa32 | 1139 | |
1140 | pragma Assert (Result = 0 or else Result = ENOMEM); | |
1141 | ||
1142 | if Result = ENOMEM then | |
1143 | raise Storage_Error; | |
1144 | end if; | |
1145 | ||
1146 | -- Initialize internal condition variable | |
1147 | ||
71e2a248 | 1148 | Result := pthread_cond_init (S.CV'Access, null); |
96d7aa32 | 1149 | |
1150 | pragma Assert (Result = 0 or else Result = ENOMEM); | |
1151 | ||
1152 | if Result /= 0 then | |
1153 | Result := pthread_mutex_destroy (S.L'Access); | |
1154 | pragma Assert (Result = 0); | |
1155 | ||
1156 | if Result = ENOMEM then | |
1157 | raise Storage_Error; | |
1158 | end if; | |
1159 | end if; | |
1160 | end Initialize; | |
1161 | ||
1162 | -------------- | |
1163 | -- Finalize -- | |
1164 | -------------- | |
1165 | ||
1166 | procedure Finalize (S : in out Suspension_Object) is | |
887e908c | 1167 | Result : Interfaces.C.int; |
1168 | ||
96d7aa32 | 1169 | begin |
1170 | -- Destroy internal mutex | |
1171 | ||
1172 | Result := pthread_mutex_destroy (S.L'Access); | |
1173 | pragma Assert (Result = 0); | |
1174 | ||
1175 | -- Destroy internal condition variable | |
1176 | ||
1177 | Result := pthread_cond_destroy (S.CV'Access); | |
1178 | pragma Assert (Result = 0); | |
1179 | end Finalize; | |
1180 | ||
1181 | ------------------- | |
1182 | -- Current_State -- | |
1183 | ------------------- | |
1184 | ||
1185 | function Current_State (S : Suspension_Object) return Boolean is | |
1186 | begin | |
1187 | -- We do not want to use lock on this read operation. State is marked | |
1188 | -- as Atomic so that we ensure that the value retrieved is correct. | |
1189 | ||
1190 | return S.State; | |
1191 | end Current_State; | |
1192 | ||
1193 | --------------- | |
1194 | -- Set_False -- | |
1195 | --------------- | |
1196 | ||
1197 | procedure Set_False (S : in out Suspension_Object) is | |
887e908c | 1198 | Result : Interfaces.C.int; |
1199 | ||
96d7aa32 | 1200 | begin |
e0bfbf32 | 1201 | SSL.Abort_Defer.all; |
1202 | ||
96d7aa32 | 1203 | Result := pthread_mutex_lock (S.L'Access); |
1204 | pragma Assert (Result = 0); | |
1205 | ||
1206 | S.State := False; | |
1207 | ||
1208 | Result := pthread_mutex_unlock (S.L'Access); | |
1209 | pragma Assert (Result = 0); | |
e0bfbf32 | 1210 | |
1211 | SSL.Abort_Undefer.all; | |
96d7aa32 | 1212 | end Set_False; |
1213 | ||
1214 | -------------- | |
1215 | -- Set_True -- | |
1216 | -------------- | |
1217 | ||
1218 | procedure Set_True (S : in out Suspension_Object) is | |
1219 | Result : Interfaces.C.int; | |
887e908c | 1220 | |
96d7aa32 | 1221 | begin |
e0bfbf32 | 1222 | SSL.Abort_Defer.all; |
1223 | ||
96d7aa32 | 1224 | Result := pthread_mutex_lock (S.L'Access); |
1225 | pragma Assert (Result = 0); | |
1226 | ||
1227 | -- If there is already a task waiting on this suspension object then | |
1228 | -- we resume it, leaving the state of the suspension object to False, | |
1229 | -- as it is specified in ARM D.10 par. 9. Otherwise, it just leaves | |
1230 | -- the state to True. | |
1231 | ||
1232 | if S.Waiting then | |
1233 | S.Waiting := False; | |
1234 | S.State := False; | |
1235 | ||
1236 | Result := pthread_cond_signal (S.CV'Access); | |
1237 | pragma Assert (Result = 0); | |
887e908c | 1238 | |
96d7aa32 | 1239 | else |
1240 | S.State := True; | |
1241 | end if; | |
1242 | ||
1243 | Result := pthread_mutex_unlock (S.L'Access); | |
1244 | pragma Assert (Result = 0); | |
e0bfbf32 | 1245 | |
1246 | SSL.Abort_Undefer.all; | |
96d7aa32 | 1247 | end Set_True; |
1248 | ||
1249 | ------------------------ | |
1250 | -- Suspend_Until_True -- | |
1251 | ------------------------ | |
1252 | ||
1253 | procedure Suspend_Until_True (S : in out Suspension_Object) is | |
1254 | Result : Interfaces.C.int; | |
887e908c | 1255 | |
96d7aa32 | 1256 | begin |
e0bfbf32 | 1257 | SSL.Abort_Defer.all; |
1258 | ||
96d7aa32 | 1259 | Result := pthread_mutex_lock (S.L'Access); |
1260 | pragma Assert (Result = 0); | |
1261 | ||
1262 | if S.Waiting then | |
887e908c | 1263 | |
96d7aa32 | 1264 | -- Program_Error must be raised upon calling Suspend_Until_True |
1265 | -- if another task is already waiting on that suspension object | |
887e908c | 1266 | -- (RM D.10(10)). |
96d7aa32 | 1267 | |
1268 | Result := pthread_mutex_unlock (S.L'Access); | |
1269 | pragma Assert (Result = 0); | |
1270 | ||
e0bfbf32 | 1271 | SSL.Abort_Undefer.all; |
1272 | ||
96d7aa32 | 1273 | raise Program_Error; |
04409526 | 1274 | |
96d7aa32 | 1275 | else |
1276 | -- Suspend the task if the state is False. Otherwise, the task | |
1277 | -- continues its execution, and the state of the suspension object | |
1278 | -- is set to False (ARM D.10 par. 9). | |
1279 | ||
1280 | if S.State then | |
1281 | S.State := False; | |
1282 | else | |
1283 | S.Waiting := True; | |
028d088b | 1284 | |
1285 | loop | |
eec7772e | 1286 | -- Loop in case pthread_cond_wait returns earlier than expected |
1287 | -- (e.g. in case of EINTR caused by a signal). This should not | |
1288 | -- happen with the current Linux implementation of pthread, but | |
04409526 | 1289 | -- POSIX does not guarantee it so this may change in future. |
028d088b | 1290 | |
1291 | Result := pthread_cond_wait (S.CV'Access, S.L'Access); | |
1292 | pragma Assert (Result = 0 or else Result = EINTR); | |
1293 | ||
1294 | exit when not S.Waiting; | |
1295 | end loop; | |
96d7aa32 | 1296 | end if; |
96d7aa32 | 1297 | |
e0bfbf32 | 1298 | Result := pthread_mutex_unlock (S.L'Access); |
1299 | pragma Assert (Result = 0); | |
1300 | ||
1301 | SSL.Abort_Undefer.all; | |
0244eba9 | 1302 | end if; |
96d7aa32 | 1303 | end Suspend_Until_True; |
1304 | ||
e6e7bf38 | 1305 | ---------------- |
1306 | -- Check_Exit -- | |
1307 | ---------------- | |
1308 | ||
3670c51d | 1309 | -- Dummy version |
e6e7bf38 | 1310 | |
7f9be362 | 1311 | function Check_Exit (Self_ID : ST.Task_Id) return Boolean is |
3670c51d | 1312 | pragma Unreferenced (Self_ID); |
e6e7bf38 | 1313 | begin |
1314 | return True; | |
1315 | end Check_Exit; | |
1316 | ||
1317 | -------------------- | |
1318 | -- Check_No_Locks -- | |
1319 | -------------------- | |
1320 | ||
7f9be362 | 1321 | function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is |
3670c51d | 1322 | pragma Unreferenced (Self_ID); |
e6e7bf38 | 1323 | begin |
1324 | return True; | |
1325 | end Check_No_Locks; | |
1326 | ||
1327 | ---------------------- | |
1328 | -- Environment_Task -- | |
1329 | ---------------------- | |
1330 | ||
7f9be362 | 1331 | function Environment_Task return Task_Id is |
e6e7bf38 | 1332 | begin |
7f9be362 | 1333 | return Environment_Task_Id; |
e6e7bf38 | 1334 | end Environment_Task; |
1335 | ||
e6e7bf38 | 1336 | ------------------ |
1337 | -- Suspend_Task -- | |
1338 | ------------------ | |
1339 | ||
1340 | function Suspend_Task | |
7f9be362 | 1341 | (T : ST.Task_Id; |
5c61a0ff | 1342 | Thread_Self : Thread_Id) return Boolean |
3670c51d | 1343 | is |
e6e7bf38 | 1344 | begin |
1345 | if T.Common.LL.Thread /= Thread_Self then | |
1346 | return pthread_kill (T.Common.LL.Thread, SIGSTOP) = 0; | |
1347 | else | |
1348 | return True; | |
1349 | end if; | |
1350 | end Suspend_Task; | |
1351 | ||
1352 | ----------------- | |
1353 | -- Resume_Task -- | |
1354 | ----------------- | |
1355 | ||
1356 | function Resume_Task | |
7f9be362 | 1357 | (T : ST.Task_Id; |
5c61a0ff | 1358 | Thread_Self : Thread_Id) return Boolean |
3670c51d | 1359 | is |
e6e7bf38 | 1360 | begin |
1361 | if T.Common.LL.Thread /= Thread_Self then | |
1362 | return pthread_kill (T.Common.LL.Thread, SIGCONT) = 0; | |
1363 | else | |
1364 | return True; | |
1365 | end if; | |
1366 | end Resume_Task; | |
1367 | ||
f23c9933 | 1368 | -------------------- |
1369 | -- Stop_All_Tasks -- | |
1370 | -------------------- | |
1371 | ||
1372 | procedure Stop_All_Tasks is | |
1373 | begin | |
1374 | null; | |
1375 | end Stop_All_Tasks; | |
1376 | ||
9a325a5c | 1377 | --------------- |
1378 | -- Stop_Task -- | |
1379 | --------------- | |
1380 | ||
1381 | function Stop_Task (T : ST.Task_Id) return Boolean is | |
1382 | pragma Unreferenced (T); | |
1383 | begin | |
1384 | return False; | |
1385 | end Stop_Task; | |
1386 | ||
f23c9933 | 1387 | ------------------- |
1388 | -- Continue_Task -- | |
1389 | ------------------- | |
1390 | ||
1391 | function Continue_Task (T : ST.Task_Id) return Boolean is | |
1392 | pragma Unreferenced (T); | |
1393 | begin | |
1394 | return False; | |
1395 | end Continue_Task; | |
1396 | ||
e6e7bf38 | 1397 | ---------------- |
1398 | -- Initialize -- | |
1399 | ---------------- | |
1400 | ||
7f9be362 | 1401 | procedure Initialize (Environment_Task : Task_Id) is |
9dfe12ae | 1402 | act : aliased struct_sigaction; |
1403 | old_act : aliased struct_sigaction; | |
1404 | Tmp_Set : aliased sigset_t; | |
1405 | Result : Interfaces.C.int; | |
0244eba9 | 1406 | -- Whether to use an alternate signal stack for stack overflows |
9dfe12ae | 1407 | |
e2aa7314 | 1408 | function State |
1409 | (Int : System.Interrupt_Management.Interrupt_ID) return Character; | |
9dfe12ae | 1410 | pragma Import (C, State, "__gnat_get_interrupt_state"); |
1411 | -- Get interrupt state. Defined in a-init.c | |
1412 | -- The input argument is the interrupt number, | |
1413 | -- and the result is one of the following: | |
1414 | ||
1415 | Default : constant Character := 's'; | |
1416 | -- 'n' this interrupt not set by any Interrupt_State pragma | |
1417 | -- 'u' Interrupt_State pragma set state to User | |
1418 | -- 'r' Interrupt_State pragma set state to Runtime | |
1419 | -- 's' Interrupt_State pragma set state to System (use "default" | |
1420 | -- system handler) | |
e6e7bf38 | 1421 | |
d9c927cc | 1422 | use type System.Multiprocessors.CPU_Range; |
1423 | ||
e6e7bf38 | 1424 | begin |
7f9be362 | 1425 | Environment_Task_Id := Environment_Task; |
e6e7bf38 | 1426 | |
51e69f04 | 1427 | Interrupt_Management.Initialize; |
1428 | ||
1429 | -- Prepare the set of signals that should be unblocked in all tasks | |
1430 | ||
1431 | Result := sigemptyset (Unblocked_Signal_Mask'Access); | |
1432 | pragma Assert (Result = 0); | |
1433 | ||
1434 | for J in Interrupt_Management.Interrupt_ID loop | |
1435 | if System.Interrupt_Management.Keep_Unmasked (J) then | |
1436 | Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J)); | |
1437 | pragma Assert (Result = 0); | |
1438 | end if; | |
1439 | end loop; | |
1440 | ||
f15731c4 | 1441 | Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level); |
3670c51d | 1442 | |
f15731c4 | 1443 | -- Initialize the global RTS lock |
1444 | ||
1445 | Specific.Initialize (Environment_Task); | |
e6e7bf38 | 1446 | |
0244eba9 | 1447 | if Use_Alternate_Stack then |
1448 | Environment_Task.Common.Task_Alternate_Stack := | |
1449 | Alternate_Stack'Address; | |
1450 | end if; | |
1451 | ||
405d066a | 1452 | -- Make environment task known here because it doesn't go through |
1453 | -- Activate_Tasks, which does it for all other tasks. | |
1454 | ||
1455 | Known_Tasks (Known_Tasks'First) := Environment_Task; | |
1456 | Environment_Task.Known_Tasks_Index := Known_Tasks'First; | |
1457 | ||
e6e7bf38 | 1458 | Enter_Task (Environment_Task); |
1459 | ||
887e908c | 1460 | if State |
1461 | (System.Interrupt_Management.Abort_Task_Interrupt) /= Default | |
9dfe12ae | 1462 | then |
1463 | act.sa_flags := 0; | |
1464 | act.sa_handler := Abort_Handler'Address; | |
e6e7bf38 | 1465 | |
9dfe12ae | 1466 | Result := sigemptyset (Tmp_Set'Access); |
1467 | pragma Assert (Result = 0); | |
1468 | act.sa_mask := Tmp_Set; | |
e6e7bf38 | 1469 | |
9dfe12ae | 1470 | Result := |
1471 | sigaction | |
1472 | (Signal (Interrupt_Management.Abort_Task_Interrupt), | |
1473 | act'Unchecked_Access, | |
1474 | old_act'Unchecked_Access); | |
1475 | pragma Assert (Result = 0); | |
d2cf6f2e | 1476 | Abort_Handler_Installed := True; |
9dfe12ae | 1477 | end if; |
d9c927cc | 1478 | |
3157c4f3 | 1479 | -- pragma CPU and dispatching domains for the environment task |
d9c927cc | 1480 | |
3157c4f3 | 1481 | Set_Task_Affinity (Environment_Task); |
1482 | end Initialize; | |
1483 | ||
1484 | ----------------------- | |
1485 | -- Set_Task_Affinity -- | |
1486 | ----------------------- | |
1487 | ||
1488 | procedure Set_Task_Affinity (T : ST.Task_Id) is | |
1489 | use type System.Multiprocessors.CPU_Range; | |
1490 | ||
1491 | begin | |
99f61ee1 | 1492 | -- Do nothing if there is no support for setting affinities or the |
1493 | -- underlying thread has not yet been created. If the thread has not | |
1494 | -- yet been created then the proper affinity will be set during its | |
1495 | -- creation. | |
1496 | ||
1497 | if pthread_setaffinity_np'Address /= System.Null_Address | |
1498 | and then T.Common.LL.Thread /= Null_Thread_Id | |
1499 | then | |
d9c927cc | 1500 | declare |
91965b95 | 1501 | CPUs : constant size_t := |
38846e90 | 1502 | Interfaces.C.size_t |
1503 | (System.Multiprocessors.Number_Of_CPUs); | |
91965b95 | 1504 | CPU_Set : cpu_set_t_ptr := null; |
1505 | Size : constant size_t := CPU_ALLOC_SIZE (CPUs); | |
f84c0da6 | 1506 | |
3157c4f3 | 1507 | Result : Interfaces.C.int; |
1508 | ||
d9c927cc | 1509 | begin |
3157c4f3 | 1510 | -- We look at the specific CPU (Base_CPU) first, then at the |
1511 | -- Task_Info field, and finally at the assigned dispatching | |
1512 | -- domain, if any. | |
1513 | ||
1514 | if T.Common.Base_CPU /= Multiprocessors.Not_A_Specific_CPU then | |
83a0ab2a | 1515 | |
3157c4f3 | 1516 | -- Set the affinity to an unique CPU |
91965b95 | 1517 | |
1518 | CPU_Set := CPU_ALLOC (CPUs); | |
1519 | System.OS_Interface.CPU_ZERO (Size, CPU_Set); | |
40d4441d | 1520 | System.OS_Interface.CPU_SET |
91965b95 | 1521 | (int (T.Common.Base_CPU), Size, CPU_Set); |
3157c4f3 | 1522 | |
1523 | -- Handle Task_Info | |
1524 | ||
91965b95 | 1525 | elsif T.Common.Task_Info /= null then |
1526 | CPU_Set := T.Common.Task_Info.CPU_Affinity'Access; | |
3157c4f3 | 1527 | |
1528 | -- Handle dispatching domains | |
1529 | ||
1530 | elsif T.Common.Domain /= null and then | |
83a0ab2a | 1531 | (T.Common.Domain /= ST.System_Domain |
1532 | or else T.Common.Domain.all /= | |
1533 | (Multiprocessors.CPU'First .. | |
1534 | Multiprocessors.Number_Of_CPUs => True)) | |
3157c4f3 | 1535 | then |
1536 | -- Set the affinity to all the processors belonging to the | |
1537 | -- dispatching domain. To avoid changing CPU affinities when | |
1538 | -- not needed, we set the affinity only when assigning to a | |
1539 | -- domain other than the default one, or when the default one | |
1540 | -- has been modified. | |
1541 | ||
91965b95 | 1542 | CPU_Set := CPU_ALLOC (CPUs); |
1543 | System.OS_Interface.CPU_ZERO (Size, CPU_Set); | |
3157c4f3 | 1544 | |
1545 | for Proc in T.Common.Domain'Range loop | |
5a8fe506 | 1546 | if T.Common.Domain (Proc) then |
1547 | System.OS_Interface.CPU_SET (int (Proc), Size, CPU_Set); | |
1548 | end if; | |
3157c4f3 | 1549 | end loop; |
1550 | end if; | |
1551 | ||
1552 | -- We set the new affinity if needed. Otherwise, the new task | |
1553 | -- will inherit its creator's CPU affinity mask (according to | |
1554 | -- the documentation of pthread_setaffinity_np), which is | |
1555 | -- consistent with Ada's required semantics. | |
1556 | ||
91965b95 | 1557 | if CPU_Set /= null then |
3157c4f3 | 1558 | Result := |
91965b95 | 1559 | pthread_setaffinity_np (T.Common.LL.Thread, Size, CPU_Set); |
3157c4f3 | 1560 | pragma Assert (Result = 0); |
91965b95 | 1561 | |
1562 | CPU_FREE (CPU_Set); | |
3157c4f3 | 1563 | end if; |
d9c927cc | 1564 | end; |
1565 | end if; | |
3157c4f3 | 1566 | end Set_Task_Affinity; |
e6e7bf38 | 1567 | |
e6e7bf38 | 1568 | end System.Task_Primitives.Operations; |