]>
Commit | Line | Data |
---|---|---|
84481f76 RK |
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 | -- -- | |
fbf5a39b | 9 | -- Copyright (C) 1992-2003, Free Software Foundation, Inc. -- |
84481f76 RK |
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 2, 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. See the GNU General Public License -- | |
17 | -- for more details. You should have received a copy of the GNU General -- | |
18 | -- Public License distributed with GNARL; see file COPYING. If not, write -- | |
19 | -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- | |
20 | -- MA 02111-1307, USA. -- | |
21 | -- -- | |
22 | -- As a special exception, if other files instantiate generics from this -- | |
23 | -- unit, or you link this unit with other files to produce an executable, -- | |
24 | -- this unit does not by itself cause the resulting executable to be -- | |
25 | -- covered by the GNU General Public License. This exception does not -- | |
26 | -- however invalidate any other reasons why the executable file might be -- | |
27 | -- covered by the GNU Public License. -- | |
28 | -- -- | |
fbf5a39b AC |
29 | -- GNARL was developed by the GNARL team at Florida State University. -- |
30 | -- Extensive contributions were provided by Ada Core Technologies, Inc. -- | |
84481f76 RK |
31 | -- -- |
32 | ------------------------------------------------------------------------------ | |
33 | ||
34 | -- This is an OS/2 version of this package | |
35 | ||
36 | -- This package contains all the GNULL primitives that interface directly | |
37 | -- with the underlying OS. | |
38 | ||
39 | pragma Polling (Off); | |
40 | -- Turn off polling, we do not want ATC polling to take place during | |
41 | -- tasking operations. It causes infinite loops and other problems. | |
42 | ||
43 | with System.Tasking.Debug; | |
44 | -- used for Known_Tasks | |
45 | ||
46 | with Interfaces.C; | |
47 | -- used for size_t | |
48 | ||
49 | with Interfaces.C.Strings; | |
50 | -- used for Null_Ptr | |
51 | ||
52 | with Interfaces.OS2Lib.Errors; | |
53 | with Interfaces.OS2Lib.Threads; | |
54 | with Interfaces.OS2Lib.Synchronization; | |
55 | ||
56 | with System.Parameters; | |
57 | -- used for Size_Type | |
58 | ||
59 | with System.Tasking; | |
60 | -- used for Task_ID | |
61 | ||
62 | with System.Parameters; | |
63 | -- used for Size_Type | |
64 | ||
65 | with System.Soft_Links; | |
66 | -- used for Defer/Undefer_Abort | |
67 | ||
68 | -- Note that we do not use System.Tasking.Initialization directly since | |
69 | -- this is a higher level package that we shouldn't depend on. For example | |
70 | -- when using the restricted run time, it is replaced by | |
71 | -- System.Tasking.Restricted.Initialization | |
72 | ||
73 | with System.OS_Primitives; | |
74 | -- used for Delay_Modes | |
75 | -- Clock | |
76 | ||
77 | with Unchecked_Conversion; | |
78 | with Unchecked_Deallocation; | |
79 | ||
80 | package body System.Task_Primitives.Operations is | |
81 | ||
82 | package IC renames Interfaces.C; | |
83 | package ICS renames Interfaces.C.Strings; | |
84 | package OSP renames System.OS_Primitives; | |
85 | package SSL renames System.Soft_Links; | |
86 | ||
87 | use Interfaces.OS2Lib; | |
88 | use Interfaces.OS2Lib.Errors; | |
89 | use Interfaces.OS2Lib.Threads; | |
90 | use Interfaces.OS2Lib.Synchronization; | |
07fc65c4 | 91 | use System.Parameters; |
84481f76 RK |
92 | use System.Tasking.Debug; |
93 | use System.Tasking; | |
94 | use System.OS_Interface; | |
95 | use Interfaces.C; | |
96 | use System.OS_Primitives; | |
97 | ||
07fc65c4 GB |
98 | --------------------- |
99 | -- Local Constants -- | |
100 | --------------------- | |
84481f76 RK |
101 | |
102 | Max_Locks_Per_Task : constant := 100; | |
103 | Suppress_Owner_Check : constant Boolean := False; | |
104 | ||
07fc65c4 GB |
105 | ----------------- |
106 | -- Local Types -- | |
107 | ----------------- | |
84481f76 | 108 | |
84481f76 RK |
109 | subtype Lock_Range is Integer range 0 .. Max_Locks_Per_Task; |
110 | ||
07fc65c4 GB |
111 | ----------------- |
112 | -- Local Data -- | |
113 | ----------------- | |
84481f76 RK |
114 | |
115 | -- The OS/2 DosAllocThreadLocalMemory API is used to allocate our TCB_Ptr. | |
116 | ||
117 | -- This API reserves a small range of virtual addresses that is backed | |
118 | -- by different physical memory for each running thread. In this case we | |
119 | -- create a pointer at a fixed address that points to the TCB_Ptr for the | |
120 | -- running thread. So all threads will be able to query and update their | |
121 | -- own TCB_Ptr without destroying the TCB_Ptr of other threads. | |
122 | ||
123 | type Thread_Local_Data is record | |
124 | Self_ID : Task_ID; -- ID of the current thread | |
125 | Lock_Prio_Level : Lock_Range; -- Nr of priority changes due to locks | |
126 | ||
127 | -- ... room for expansion here, if we decide to make access to | |
128 | -- jump-buffer and exception stack more efficient in future | |
129 | end record; | |
130 | ||
131 | type Access_Thread_Local_Data is access all Thread_Local_Data; | |
132 | ||
133 | -- Pointer to Thread Local Data | |
134 | Thread_Local_Data_Ptr : aliased Access_Thread_Local_Data; | |
135 | ||
136 | type PPTLD is access all Access_Thread_Local_Data; | |
137 | ||
07fc65c4 GB |
138 | Single_RTS_Lock : aliased RTS_Lock; |
139 | -- This is a lock to allow only one thread of control in the RTS at | |
140 | -- a time; it is used to execute in mutual exclusion from all other tasks. | |
141 | -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List | |
84481f76 RK |
142 | |
143 | Environment_Task_ID : Task_ID; | |
144 | -- A variable to hold Task_ID for the environment task. | |
145 | ||
146 | ----------------------- | |
147 | -- Local Subprograms -- | |
148 | ----------------------- | |
149 | ||
150 | function To_PPVOID is new Unchecked_Conversion (PPTLD, PPVOID); | |
151 | function To_Address is new Unchecked_Conversion (Task_ID, System.Address); | |
152 | function To_PFNTHREAD is | |
153 | new Unchecked_Conversion (System.Address, PFNTHREAD); | |
154 | ||
155 | function To_MS (D : Duration) return ULONG; | |
156 | ||
157 | procedure Set_Temporary_Priority | |
158 | (T : in Task_ID; | |
159 | New_Priority : in System.Any_Priority); | |
160 | ||
161 | ----------- | |
162 | -- To_MS -- | |
163 | ----------- | |
164 | ||
165 | function To_MS (D : Duration) return ULONG is | |
166 | begin | |
167 | return ULONG (D * 1_000); | |
168 | end To_MS; | |
169 | ||
170 | ----------- | |
171 | -- Clock -- | |
172 | ----------- | |
173 | ||
174 | function Monotonic_Clock return Duration renames OSP.Monotonic_Clock; | |
175 | ||
176 | ------------------- | |
177 | -- RT_Resolution -- | |
178 | ------------------- | |
179 | ||
180 | function RT_Resolution return Duration is | |
181 | begin | |
182 | return 10#1.0#E-6; | |
183 | end RT_Resolution; | |
184 | ||
185 | ------------------- | |
186 | -- Abort_Handler -- | |
187 | ------------------- | |
188 | ||
189 | -- OS/2 only has limited support for asynchronous signals. | |
190 | -- It seems not to be possible to jump out of an exception | |
191 | -- handler or to change the execution context of the thread. | |
192 | -- So asynchonous transfer of control is not supported. | |
193 | ||
07fc65c4 GB |
194 | ----------------- |
195 | -- Stack_Guard -- | |
196 | ----------------- | |
84481f76 RK |
197 | |
198 | -- The underlying thread system sets a guard page at the | |
199 | -- bottom of a thread stack, so nothing is needed. | |
200 | -- ??? Check the comment above | |
201 | ||
202 | procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is | |
fbf5a39b AC |
203 | pragma Unreferenced (T); |
204 | pragma Unreferenced (On); | |
07fc65c4 | 205 | |
84481f76 RK |
206 | begin |
207 | null; | |
208 | end Stack_Guard; | |
209 | ||
210 | -------------------- | |
211 | -- Get_Thread_Id -- | |
212 | -------------------- | |
213 | ||
214 | function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id is | |
215 | begin | |
216 | return OSI.Thread_Id (T.Common.LL.Thread); | |
217 | end Get_Thread_Id; | |
218 | ||
219 | ---------- | |
220 | -- Self -- | |
221 | ---------- | |
222 | ||
223 | function Self return Task_ID is | |
224 | Self_ID : Task_ID renames Thread_Local_Data_Ptr.Self_ID; | |
84481f76 RK |
225 | begin |
226 | -- Check that the thread local data has been initialized. | |
227 | ||
228 | pragma Assert | |
229 | ((Thread_Local_Data_Ptr /= null | |
230 | and then Thread_Local_Data_Ptr.Self_ID /= null)); | |
231 | ||
232 | return Self_ID; | |
233 | end Self; | |
234 | ||
235 | --------------------- | |
236 | -- Initialize_Lock -- | |
237 | --------------------- | |
238 | ||
239 | procedure Initialize_Lock | |
240 | (Prio : System.Any_Priority; | |
241 | L : access Lock) | |
242 | is | |
243 | begin | |
244 | if DosCreateMutexSem | |
245 | (ICS.Null_Ptr, L.Mutex'Unchecked_Access, 0, False32) /= NO_ERROR | |
246 | then | |
247 | raise Storage_Error; | |
248 | end if; | |
249 | ||
250 | pragma Assert (L.Mutex /= 0, "Error creating Mutex"); | |
251 | L.Priority := Prio; | |
252 | L.Owner_ID := Null_Address; | |
253 | end Initialize_Lock; | |
254 | ||
255 | procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is | |
fbf5a39b | 256 | pragma Unreferenced (Level); |
07fc65c4 | 257 | |
84481f76 RK |
258 | begin |
259 | if DosCreateMutexSem | |
260 | (ICS.Null_Ptr, L.Mutex'Unchecked_Access, 0, False32) /= NO_ERROR | |
261 | then | |
262 | raise Storage_Error; | |
263 | end if; | |
264 | ||
265 | pragma Assert (L.Mutex /= 0, "Error creating Mutex"); | |
266 | ||
267 | L.Priority := System.Any_Priority'Last; | |
268 | L.Owner_ID := Null_Address; | |
269 | end Initialize_Lock; | |
270 | ||
271 | ------------------- | |
272 | -- Finalize_Lock -- | |
273 | ------------------- | |
274 | ||
275 | procedure Finalize_Lock (L : access Lock) is | |
276 | begin | |
277 | Must_Not_Fail (DosCloseMutexSem (L.Mutex)); | |
278 | end Finalize_Lock; | |
279 | ||
280 | procedure Finalize_Lock (L : access RTS_Lock) is | |
281 | begin | |
282 | Must_Not_Fail (DosCloseMutexSem (L.Mutex)); | |
283 | end Finalize_Lock; | |
284 | ||
285 | ---------------- | |
286 | -- Write_Lock -- | |
287 | ---------------- | |
288 | ||
289 | procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is | |
290 | Self_ID : constant Task_ID := Thread_Local_Data_Ptr.Self_ID; | |
291 | Old_Priority : constant Any_Priority := | |
fbf5a39b | 292 | Self_ID.Common.LL.Current_Priority; |
84481f76 RK |
293 | |
294 | begin | |
295 | if L.Priority < Old_Priority then | |
296 | Ceiling_Violation := True; | |
297 | return; | |
298 | end if; | |
299 | ||
300 | Ceiling_Violation := False; | |
301 | ||
302 | -- Increase priority before getting the lock | |
303 | -- to prevent priority inversion | |
304 | ||
305 | Thread_Local_Data_Ptr.Lock_Prio_Level := | |
306 | Thread_Local_Data_Ptr.Lock_Prio_Level + 1; | |
307 | if L.Priority > Old_Priority then | |
308 | Set_Temporary_Priority (Self_ID, L.Priority); | |
309 | end if; | |
310 | ||
311 | -- Request the lock and then update the lock owner data | |
312 | ||
313 | Must_Not_Fail (DosRequestMutexSem (L.Mutex, SEM_INDEFINITE_WAIT)); | |
314 | L.Owner_Priority := Old_Priority; | |
315 | L.Owner_ID := Self_ID.all'Address; | |
316 | end Write_Lock; | |
317 | ||
07fc65c4 | 318 | procedure Write_Lock |
fbf5a39b AC |
319 | (L : access RTS_Lock; |
320 | Global_Lock : Boolean := False) | |
07fc65c4 GB |
321 | is |
322 | Self_ID : Task_ID; | |
323 | Old_Priority : Any_Priority; | |
84481f76 RK |
324 | |
325 | begin | |
07fc65c4 GB |
326 | if not Single_Lock or else Global_Lock then |
327 | Self_ID := Thread_Local_Data_Ptr.Self_ID; | |
328 | Old_Priority := Self_ID.Common.LL.Current_Priority; | |
84481f76 | 329 | |
07fc65c4 GB |
330 | -- Increase priority before getting the lock |
331 | -- to prevent priority inversion | |
84481f76 | 332 | |
07fc65c4 GB |
333 | Thread_Local_Data_Ptr.Lock_Prio_Level := |
334 | Thread_Local_Data_Ptr.Lock_Prio_Level + 1; | |
84481f76 | 335 | |
07fc65c4 GB |
336 | if L.Priority > Old_Priority then |
337 | Set_Temporary_Priority (Self_ID, L.Priority); | |
338 | end if; | |
84481f76 | 339 | |
07fc65c4 GB |
340 | -- Request the lock and then update the lock owner data |
341 | ||
342 | Must_Not_Fail (DosRequestMutexSem (L.Mutex, SEM_INDEFINITE_WAIT)); | |
343 | L.Owner_Priority := Old_Priority; | |
344 | L.Owner_ID := Self_ID.all'Address; | |
345 | end if; | |
84481f76 RK |
346 | end Write_Lock; |
347 | ||
348 | procedure Write_Lock (T : Task_ID) is | |
349 | begin | |
07fc65c4 | 350 | if not Single_Lock then |
fbf5a39b | 351 | |
07fc65c4 | 352 | -- Request the lock and then update the lock owner data |
84481f76 | 353 | |
07fc65c4 GB |
354 | Must_Not_Fail |
355 | (DosRequestMutexSem (T.Common.LL.L.Mutex, SEM_INDEFINITE_WAIT)); | |
356 | T.Common.LL.L.Owner_ID := Null_Address; | |
357 | end if; | |
84481f76 RK |
358 | end Write_Lock; |
359 | ||
360 | --------------- | |
361 | -- Read_Lock -- | |
362 | --------------- | |
363 | ||
07fc65c4 GB |
364 | procedure Read_Lock |
365 | (L : access Lock; Ceiling_Violation : out Boolean) renames Write_Lock; | |
84481f76 RK |
366 | |
367 | ------------ | |
368 | -- Unlock -- | |
369 | ------------ | |
370 | ||
371 | procedure Unlock (L : access Lock) is | |
372 | Self_ID : constant Task_ID := Thread_Local_Data_Ptr.Self_ID; | |
373 | Old_Priority : constant Any_Priority := L.Owner_Priority; | |
374 | ||
375 | begin | |
376 | -- Check that this task holds the lock | |
377 | ||
378 | pragma Assert (Suppress_Owner_Check | |
379 | or else L.Owner_ID = Self_ID.all'Address); | |
380 | ||
381 | -- Upate the owner data | |
382 | ||
383 | L.Owner_ID := Null_Address; | |
384 | ||
385 | -- Do the actual unlocking. No more references | |
386 | -- to owner data of L after this point. | |
387 | ||
388 | Must_Not_Fail (DosReleaseMutexSem (L.Mutex)); | |
389 | ||
390 | -- Reset priority after unlocking to avoid priority inversion | |
391 | ||
392 | Thread_Local_Data_Ptr.Lock_Prio_Level := | |
393 | Thread_Local_Data_Ptr.Lock_Prio_Level - 1; | |
394 | if L.Priority /= Old_Priority then | |
395 | Set_Temporary_Priority (Self_ID, Old_Priority); | |
396 | end if; | |
397 | end Unlock; | |
398 | ||
07fc65c4 GB |
399 | procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is |
400 | Self_ID : Task_ID; | |
401 | Old_Priority : Any_Priority; | |
84481f76 RK |
402 | |
403 | begin | |
07fc65c4 GB |
404 | if not Single_Lock or else Global_Lock then |
405 | Self_ID := Thread_Local_Data_Ptr.Self_ID; | |
406 | Old_Priority := L.Owner_Priority; | |
407 | -- Check that this task holds the lock | |
84481f76 | 408 | |
07fc65c4 GB |
409 | pragma Assert (Suppress_Owner_Check |
410 | or else L.Owner_ID = Self_ID.all'Address); | |
84481f76 | 411 | |
07fc65c4 | 412 | -- Upate the owner data |
84481f76 | 413 | |
07fc65c4 | 414 | L.Owner_ID := Null_Address; |
84481f76 | 415 | |
07fc65c4 GB |
416 | -- Do the actual unlocking. No more references |
417 | -- to owner data of L after this point. | |
84481f76 | 418 | |
07fc65c4 | 419 | Must_Not_Fail (DosReleaseMutexSem (L.Mutex)); |
84481f76 | 420 | |
07fc65c4 | 421 | -- Reset priority after unlocking to avoid priority inversion |
fbf5a39b | 422 | |
07fc65c4 GB |
423 | Thread_Local_Data_Ptr.Lock_Prio_Level := |
424 | Thread_Local_Data_Ptr.Lock_Prio_Level - 1; | |
84481f76 | 425 | |
07fc65c4 GB |
426 | if L.Priority /= Old_Priority then |
427 | Set_Temporary_Priority (Self_ID, Old_Priority); | |
428 | end if; | |
84481f76 RK |
429 | end if; |
430 | end Unlock; | |
431 | ||
432 | procedure Unlock (T : Task_ID) is | |
433 | begin | |
07fc65c4 | 434 | if not Single_Lock then |
fbf5a39b | 435 | |
07fc65c4 | 436 | -- Check the owner data |
84481f76 | 437 | |
07fc65c4 GB |
438 | pragma Assert (Suppress_Owner_Check |
439 | or else T.Common.LL.L.Owner_ID = Null_Address); | |
84481f76 | 440 | |
07fc65c4 GB |
441 | -- Do the actual unlocking. No more references |
442 | -- to owner data of T.Common.LL.L after this point. | |
84481f76 | 443 | |
07fc65c4 GB |
444 | Must_Not_Fail (DosReleaseMutexSem (T.Common.LL.L.Mutex)); |
445 | end if; | |
84481f76 RK |
446 | end Unlock; |
447 | ||
448 | ----------- | |
449 | -- Sleep -- | |
450 | ----------- | |
451 | ||
07fc65c4 GB |
452 | procedure Sleep |
453 | (Self_ID : Task_ID; | |
454 | Reason : System.Tasking.Task_States) | |
455 | is | |
fbf5a39b | 456 | pragma Unreferenced (Reason); |
07fc65c4 | 457 | |
84481f76 RK |
458 | Count : aliased ULONG; -- Used to store dummy result |
459 | ||
460 | begin | |
461 | -- Must reset Cond BEFORE L is unlocked. | |
462 | ||
463 | Sem_Must_Not_Fail | |
464 | (DosResetEventSem (Self_ID.Common.LL.CV, Count'Unchecked_Access)); | |
07fc65c4 GB |
465 | |
466 | if Single_Lock then | |
467 | Unlock_RTS; | |
468 | else | |
469 | Unlock (Self_ID); | |
470 | end if; | |
84481f76 RK |
471 | |
472 | -- No problem if we are interrupted here. | |
473 | -- If the condition is signaled, DosWaitEventSem will simply not block. | |
474 | ||
475 | Sem_Must_Not_Fail | |
476 | (DosWaitEventSem (Self_ID.Common.LL.CV, SEM_INDEFINITE_WAIT)); | |
477 | ||
478 | -- Since L was previously accquired, lock operation should not fail. | |
479 | ||
07fc65c4 GB |
480 | if Single_Lock then |
481 | Lock_RTS; | |
482 | else | |
483 | Write_Lock (Self_ID); | |
484 | end if; | |
84481f76 RK |
485 | end Sleep; |
486 | ||
487 | ----------------- | |
488 | -- Timed_Sleep -- | |
489 | ----------------- | |
490 | ||
491 | -- This is for use within the run-time system, so abort is | |
492 | -- assumed to be already deferred, and the caller should be | |
493 | -- holding its own ATCB lock. | |
494 | ||
495 | -- Pre-assertion: Cond is posted | |
496 | -- Self is locked. | |
497 | ||
498 | -- Post-assertion: Cond is posted | |
499 | -- Self is locked. | |
500 | ||
501 | procedure Timed_Sleep | |
502 | (Self_ID : Task_ID; | |
503 | Time : Duration; | |
504 | Mode : ST.Delay_Modes; | |
505 | Reason : System.Tasking.Task_States; | |
506 | Timedout : out Boolean; | |
507 | Yielded : out Boolean) | |
508 | is | |
fbf5a39b | 509 | pragma Unreferenced (Reason); |
07fc65c4 | 510 | |
84481f76 RK |
511 | Check_Time : constant Duration := OSP.Monotonic_Clock; |
512 | Rel_Time : Duration; | |
513 | Abs_Time : Duration; | |
514 | Time_Out : ULONG; | |
515 | Result : APIRET; | |
516 | Count : aliased ULONG; -- Used to store dummy result | |
517 | ||
518 | begin | |
519 | -- Must reset Cond BEFORE Self_ID is unlocked. | |
520 | ||
521 | Sem_Must_Not_Fail | |
522 | (DosResetEventSem (Self_ID.Common.LL.CV, | |
523 | Count'Unchecked_Access)); | |
07fc65c4 GB |
524 | |
525 | if Single_Lock then | |
526 | Unlock_RTS; | |
527 | else | |
528 | Unlock (Self_ID); | |
529 | end if; | |
84481f76 RK |
530 | |
531 | Timedout := True; | |
532 | Yielded := False; | |
533 | ||
534 | if Mode = Relative then | |
535 | Rel_Time := Time; | |
536 | Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time; | |
537 | else | |
538 | Rel_Time := Time - Check_Time; | |
539 | Abs_Time := Time; | |
540 | end if; | |
541 | ||
542 | if Rel_Time > 0.0 then | |
543 | loop | |
544 | exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level | |
545 | or else Self_ID.Pending_Priority_Change; | |
546 | ||
547 | Time_Out := To_MS (Rel_Time); | |
548 | Result := DosWaitEventSem (Self_ID.Common.LL.CV, Time_Out); | |
549 | pragma Assert | |
550 | ((Result = NO_ERROR or Result = ERROR_TIMEOUT | |
551 | or Result = ERROR_INTERRUPT)); | |
552 | ||
553 | -- ??? | |
554 | -- What to do with error condition ERROR_NOT_ENOUGH_MEMORY? Can | |
555 | -- we raise an exception here? And what about ERROR_INTERRUPT? | |
556 | -- Should that be treated as a simple timeout? | |
557 | -- For now, consider only ERROR_TIMEOUT to be a timeout. | |
558 | ||
559 | exit when Abs_Time <= OSP.Monotonic_Clock; | |
560 | ||
561 | if Result /= ERROR_TIMEOUT then | |
562 | -- somebody may have called Wakeup for us | |
563 | Timedout := False; | |
564 | exit; | |
565 | end if; | |
566 | ||
567 | Rel_Time := Abs_Time - OSP.Monotonic_Clock; | |
568 | end loop; | |
569 | end if; | |
570 | ||
571 | -- Ensure post-condition | |
572 | ||
07fc65c4 GB |
573 | if Single_Lock then |
574 | Lock_RTS; | |
575 | else | |
576 | Write_Lock (Self_ID); | |
577 | end if; | |
84481f76 RK |
578 | |
579 | if Timedout then | |
580 | Sem_Must_Not_Fail (DosPostEventSem (Self_ID.Common.LL.CV)); | |
581 | end if; | |
582 | end Timed_Sleep; | |
583 | ||
584 | ----------------- | |
585 | -- Timed_Delay -- | |
586 | ----------------- | |
587 | ||
588 | procedure Timed_Delay | |
589 | (Self_ID : Task_ID; | |
590 | Time : Duration; | |
591 | Mode : ST.Delay_Modes) | |
592 | is | |
593 | Check_Time : constant Duration := OSP.Monotonic_Clock; | |
594 | Rel_Time : Duration; | |
595 | Abs_Time : Duration; | |
596 | Timedout : Boolean := True; | |
597 | Time_Out : ULONG; | |
07fc65c4 | 598 | Result : APIRET; |
84481f76 RK |
599 | Count : aliased ULONG; -- Used to store dummy result |
600 | ||
601 | begin | |
602 | -- Only the little window between deferring abort and | |
603 | -- locking Self_ID is the reason we need to | |
604 | -- check for pending abort and priority change below! :( | |
605 | ||
606 | SSL.Abort_Defer.all; | |
07fc65c4 GB |
607 | |
608 | if Single_Lock then | |
609 | Lock_RTS; | |
610 | else | |
611 | Write_Lock (Self_ID); | |
612 | end if; | |
84481f76 RK |
613 | |
614 | -- Must reset Cond BEFORE Self_ID is unlocked. | |
615 | ||
616 | Sem_Must_Not_Fail | |
617 | (DosResetEventSem (Self_ID.Common.LL.CV, | |
618 | Count'Unchecked_Access)); | |
07fc65c4 GB |
619 | |
620 | if Single_Lock then | |
621 | Unlock_RTS; | |
622 | else | |
623 | Unlock (Self_ID); | |
624 | end if; | |
84481f76 RK |
625 | |
626 | if Mode = Relative then | |
627 | Rel_Time := Time; | |
628 | Abs_Time := Time + Check_Time; | |
629 | else | |
630 | Rel_Time := Time - Check_Time; | |
631 | Abs_Time := Time; | |
632 | end if; | |
633 | ||
634 | if Rel_Time > 0.0 then | |
635 | Self_ID.Common.State := Delay_Sleep; | |
07fc65c4 | 636 | |
84481f76 RK |
637 | loop |
638 | if Self_ID.Pending_Priority_Change then | |
639 | Self_ID.Pending_Priority_Change := False; | |
640 | Self_ID.Common.Base_Priority := Self_ID.New_Base_Priority; | |
641 | Set_Priority (Self_ID, Self_ID.Common.Base_Priority); | |
642 | end if; | |
643 | ||
644 | exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level; | |
645 | ||
646 | Time_Out := To_MS (Rel_Time); | |
647 | Result := DosWaitEventSem (Self_ID.Common.LL.CV, Time_Out); | |
648 | ||
649 | exit when Abs_Time <= OSP.Monotonic_Clock; | |
650 | ||
651 | Rel_Time := Abs_Time - OSP.Monotonic_Clock; | |
652 | end loop; | |
653 | ||
654 | Self_ID.Common.State := Runnable; | |
655 | Timedout := Result = ERROR_TIMEOUT; | |
656 | end if; | |
657 | ||
07fc65c4 GB |
658 | if Single_Lock then |
659 | Lock_RTS; | |
660 | else | |
661 | Write_Lock (Self_ID); | |
662 | end if; | |
84481f76 RK |
663 | |
664 | if Timedout then | |
665 | Sem_Must_Not_Fail (DosPostEventSem (Self_ID.Common.LL.CV)); | |
666 | end if; | |
667 | ||
07fc65c4 GB |
668 | if Single_Lock then |
669 | Unlock_RTS; | |
670 | else | |
671 | Unlock (Self_ID); | |
672 | end if; | |
673 | ||
84481f76 RK |
674 | System.OS_Interface.Yield; |
675 | SSL.Abort_Undefer.all; | |
676 | end Timed_Delay; | |
677 | ||
678 | ------------ | |
679 | -- Wakeup -- | |
680 | ------------ | |
681 | ||
682 | procedure Wakeup (T : Task_ID; Reason : System.Tasking.Task_States) is | |
fbf5a39b AC |
683 | pragma Unreferenced (Reason); |
684 | ||
84481f76 RK |
685 | begin |
686 | Sem_Must_Not_Fail (DosPostEventSem (T.Common.LL.CV)); | |
687 | end Wakeup; | |
688 | ||
689 | ----------- | |
690 | -- Yield -- | |
691 | ----------- | |
692 | ||
693 | procedure Yield (Do_Yield : Boolean := True) is | |
694 | begin | |
695 | if Do_Yield then | |
696 | System.OS_Interface.Yield; | |
697 | end if; | |
698 | end Yield; | |
699 | ||
700 | ---------------------------- | |
701 | -- Set_Temporary_Priority -- | |
702 | ---------------------------- | |
703 | ||
704 | procedure Set_Temporary_Priority | |
705 | (T : Task_ID; | |
706 | New_Priority : System.Any_Priority) | |
707 | is | |
708 | use Interfaces.C; | |
709 | Delta_Priority : Integer; | |
710 | ||
711 | begin | |
712 | -- When Lock_Prio_Level = 0, we always need to set the | |
713 | -- Active_Priority. In this way we can make priority changes | |
714 | -- due to locking independent of those caused by calling | |
715 | -- Set_Priority. | |
716 | ||
717 | if Thread_Local_Data_Ptr.Lock_Prio_Level = 0 | |
718 | or else New_Priority < T.Common.Current_Priority | |
719 | then | |
720 | Delta_Priority := T.Common.Current_Priority - | |
721 | T.Common.LL.Current_Priority; | |
722 | else | |
723 | Delta_Priority := New_Priority - T.Common.LL.Current_Priority; | |
724 | end if; | |
725 | ||
726 | if Delta_Priority /= 0 then | |
84481f76 RK |
727 | -- ??? There is a race-condition here |
728 | -- The TCB is updated before the system call to make | |
729 | -- pre-emption in the critical section less likely. | |
730 | ||
731 | T.Common.LL.Current_Priority := | |
732 | T.Common.LL.Current_Priority + Delta_Priority; | |
733 | Must_Not_Fail | |
734 | (DosSetPriority (Scope => PRTYS_THREAD, | |
735 | Class => PRTYC_NOCHANGE, | |
736 | Delta_P => IC.long (Delta_Priority), | |
737 | PorTid => T.Common.LL.Thread)); | |
738 | end if; | |
739 | end Set_Temporary_Priority; | |
740 | ||
741 | ------------------ | |
742 | -- Set_Priority -- | |
743 | ------------------ | |
744 | ||
745 | procedure Set_Priority | |
07fc65c4 GB |
746 | (T : Task_ID; |
747 | Prio : System.Any_Priority; | |
748 | Loss_Of_Inheritance : Boolean := False) | |
749 | is | |
fbf5a39b | 750 | pragma Unreferenced (Loss_Of_Inheritance); |
07fc65c4 | 751 | |
84481f76 RK |
752 | begin |
753 | T.Common.Current_Priority := Prio; | |
754 | Set_Temporary_Priority (T, Prio); | |
755 | end Set_Priority; | |
756 | ||
757 | ------------------ | |
758 | -- Get_Priority -- | |
759 | ------------------ | |
760 | ||
761 | function Get_Priority (T : Task_ID) return System.Any_Priority is | |
762 | begin | |
763 | return T.Common.Current_Priority; | |
764 | end Get_Priority; | |
765 | ||
766 | ---------------- | |
767 | -- Enter_Task -- | |
768 | ---------------- | |
769 | ||
770 | procedure Enter_Task (Self_ID : Task_ID) is | |
771 | begin | |
84481f76 RK |
772 | -- Initialize thread local data. Must be done first. |
773 | ||
774 | Thread_Local_Data_Ptr.Self_ID := Self_ID; | |
775 | Thread_Local_Data_Ptr.Lock_Prio_Level := 0; | |
776 | ||
07fc65c4 GB |
777 | Lock_RTS; |
778 | ||
779 | for J in Known_Tasks'Range loop | |
780 | if Known_Tasks (J) = null then | |
781 | Known_Tasks (J) := Self_ID; | |
782 | Self_ID.Known_Tasks_Index := J; | |
84481f76 RK |
783 | exit; |
784 | end if; | |
785 | end loop; | |
07fc65c4 GB |
786 | |
787 | Unlock_RTS; | |
84481f76 RK |
788 | |
789 | -- For OS/2, we can set Self_ID.Common.LL.Thread in | |
790 | -- Create_Task, since the thread is created suspended. | |
791 | -- That is, there is no danger of the thread racing ahead | |
792 | -- and trying to reference Self_ID.Common.LL.Thread before it | |
793 | -- has been initialized. | |
794 | ||
795 | -- .... Do we need to do anything with signals for OS/2 ??? | |
84481f76 RK |
796 | end Enter_Task; |
797 | ||
798 | -------------- | |
799 | -- New_ATCB -- | |
800 | -------------- | |
801 | ||
802 | function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is | |
803 | begin | |
804 | return new Ada_Task_Control_Block (Entry_Num); | |
805 | end New_ATCB; | |
806 | ||
fbf5a39b AC |
807 | ------------------- |
808 | -- Is_Valid_Task -- | |
809 | ------------------- | |
810 | ||
811 | function Is_Valid_Task return Boolean is | |
812 | begin | |
813 | return False; | |
814 | end Is_Valid_Task; | |
815 | ||
816 | ----------------------------- | |
817 | -- Register_Foreign_Thread -- | |
818 | ----------------------------- | |
819 | ||
820 | function Register_Foreign_Thread return Task_ID is | |
821 | begin | |
822 | return null; | |
823 | end Register_Foreign_Thread; | |
824 | ||
825 | -------------------- | |
826 | -- Initialize_TCB -- | |
827 | -------------------- | |
84481f76 RK |
828 | |
829 | procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is | |
830 | begin | |
831 | if DosCreateEventSem (ICS.Null_Ptr, | |
832 | Self_ID.Common.LL.CV'Unchecked_Access, 0, True32) = NO_ERROR | |
833 | then | |
07fc65c4 GB |
834 | if not Single_Lock |
835 | and then DosCreateMutexSem | |
836 | (ICS.Null_Ptr, | |
837 | Self_ID.Common.LL.L.Mutex'Unchecked_Access, | |
838 | 0, | |
839 | False32) /= NO_ERROR | |
84481f76 RK |
840 | then |
841 | Succeeded := False; | |
842 | Must_Not_Fail (DosCloseEventSem (Self_ID.Common.LL.CV)); | |
843 | else | |
844 | Succeeded := True; | |
845 | end if; | |
846 | ||
84481f76 RK |
847 | -- We now want to do the equivalent of: |
848 | ||
849 | -- Initialize_Lock | |
850 | -- (Self_ID.Common.LL.L'Unchecked_Access, ATCB_Level); | |
851 | ||
852 | -- But we avoid that because the Initialize_TCB routine has an | |
853 | -- exception handler, and it is too early for us to deal with | |
854 | -- installing handlers (see comment below), so we do our own | |
855 | -- Initialize_Lock operation manually. | |
856 | ||
857 | Self_ID.Common.LL.L.Priority := System.Any_Priority'Last; | |
858 | Self_ID.Common.LL.L.Owner_ID := Null_Address; | |
859 | ||
860 | else | |
861 | Succeeded := False; | |
862 | end if; | |
863 | ||
07fc65c4 | 864 | -- Note: at one time we had an exception handler here, whose code |
84481f76 RK |
865 | -- was as follows: |
866 | ||
867 | -- exception | |
868 | ||
869 | -- Assumes any failure must be due to insufficient resources | |
870 | ||
871 | -- when Storage_Error => | |
872 | -- Must_Not_Fail (DosCloseEventSem (Self_ID.Common.LL.CV)); | |
873 | -- Succeeded := False; | |
874 | ||
875 | -- but that won't work with the old exception scheme, since it would | |
876 | -- result in messing with Jmpbuf values too early. If and when we get | |
877 | -- switched entirely to the new zero-cost exception scheme, we could | |
878 | -- put this handler back in! | |
84481f76 RK |
879 | end Initialize_TCB; |
880 | ||
881 | ----------------- | |
882 | -- Create_Task -- | |
883 | ----------------- | |
884 | ||
885 | procedure Create_Task | |
886 | (T : Task_ID; | |
887 | Wrapper : System.Address; | |
888 | Stack_Size : System.Parameters.Size_Type; | |
889 | Priority : System.Any_Priority; | |
890 | Succeeded : out Boolean) | |
891 | is | |
892 | Result : aliased APIRET; | |
893 | Adjusted_Stack_Size : System.Parameters.Size_Type; | |
894 | use System.Parameters; | |
895 | ||
896 | begin | |
897 | -- In OS/2 the allocated stack size should be based on the | |
898 | -- amount of address space that should be reserved for the stack. | |
899 | -- Actual memory will only be used when the stack is touched anyway. | |
900 | ||
901 | -- The new minimum size is 12 kB, although the EMX docs | |
902 | -- recommend a minimum size of 32 kB. (The original was 4 kB) | |
903 | -- Systems that use many tasks (say > 30) and require much | |
904 | -- memory may run out of virtual address space, since OS/2 | |
fbf5a39b | 905 | -- has a per-proces limit of 512 MB, of which max. 300 MB is |
84481f76 RK |
906 | -- usable in practise. |
907 | ||
908 | if Stack_Size = Unspecified_Size then | |
909 | Adjusted_Stack_Size := Default_Stack_Size; | |
910 | ||
911 | elsif Stack_Size < Minimum_Stack_Size then | |
912 | Adjusted_Stack_Size := Minimum_Stack_Size; | |
913 | ||
914 | else | |
915 | Adjusted_Stack_Size := Stack_Size; | |
916 | end if; | |
917 | ||
918 | -- GB970222: | |
919 | -- Because DosCreateThread is called directly here, the | |
920 | -- C RTL doesn't get initialized for the new thead. EMX by | |
921 | -- default uses per-thread local heaps in addition to the | |
922 | -- global heap. There might be other effects of by-passing the | |
923 | -- C library here. | |
924 | ||
925 | -- When using _beginthread the newly created thread is not | |
926 | -- blocked initially. Does this matter or can I create the | |
927 | -- thread running anyway? The LL.Thread variable will be set | |
928 | -- anyway because the variable is passed by reference to OS/2. | |
929 | ||
930 | T.Common.LL.Wrapper := To_PFNTHREAD (Wrapper); | |
931 | ||
932 | -- The OS implicitly gives the new task the priority of this task. | |
933 | ||
934 | T.Common.LL.Current_Priority := Self.Common.LL.Current_Priority; | |
935 | ||
936 | -- If task was locked before activator task was | |
937 | -- initialized, assume it has OS standard priority | |
938 | ||
939 | if T.Common.LL.L.Owner_Priority not in Any_Priority'Range then | |
940 | T.Common.LL.L.Owner_Priority := 1; | |
941 | end if; | |
942 | ||
943 | -- Create the thread, in blocked mode | |
944 | ||
945 | Result := DosCreateThread | |
946 | (F_ptid => T.Common.LL.Thread'Unchecked_Access, | |
947 | pfn => T.Common.LL.Wrapper, | |
948 | param => To_Address (T), | |
949 | flag => Block_Child + Commit_Stack, | |
950 | cbStack => ULONG (Adjusted_Stack_Size)); | |
951 | ||
952 | Succeeded := (Result = NO_ERROR); | |
953 | ||
954 | if not Succeeded then | |
955 | return; | |
956 | end if; | |
957 | ||
958 | -- Set the new thread's priority | |
959 | -- (child has inherited priority from parent) | |
960 | ||
961 | Set_Priority (T, Priority); | |
962 | ||
963 | -- Start the thread executing | |
964 | ||
965 | Must_Not_Fail (DosResumeThread (T.Common.LL.Thread)); | |
966 | ||
967 | end Create_Task; | |
968 | ||
969 | ------------------ | |
970 | -- Finalize_TCB -- | |
971 | ------------------ | |
972 | ||
973 | procedure Finalize_TCB (T : Task_ID) is | |
974 | Tmp : Task_ID := T; | |
975 | ||
976 | procedure Free is new | |
977 | Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID); | |
07fc65c4 | 978 | |
84481f76 RK |
979 | begin |
980 | Must_Not_Fail (DosCloseEventSem (T.Common.LL.CV)); | |
07fc65c4 GB |
981 | |
982 | if not Single_Lock then | |
983 | Finalize_Lock (T.Common.LL.L'Unchecked_Access); | |
984 | end if; | |
985 | ||
84481f76 RK |
986 | if T.Known_Tasks_Index /= -1 then |
987 | Known_Tasks (T.Known_Tasks_Index) := null; | |
988 | end if; | |
07fc65c4 | 989 | |
84481f76 RK |
990 | Free (Tmp); |
991 | end Finalize_TCB; | |
992 | ||
993 | --------------- | |
994 | -- Exit_Task -- | |
995 | --------------- | |
996 | ||
997 | procedure Exit_Task is | |
998 | begin | |
fbf5a39b | 999 | Thread_Local_Data_Ptr := null; |
84481f76 RK |
1000 | end Exit_Task; |
1001 | ||
1002 | ---------------- | |
1003 | -- Abort_Task -- | |
1004 | ---------------- | |
1005 | ||
1006 | procedure Abort_Task (T : Task_ID) is | |
fbf5a39b | 1007 | pragma Unreferenced (T); |
07fc65c4 | 1008 | |
84481f76 RK |
1009 | begin |
1010 | null; | |
1011 | ||
1012 | -- Task abortion not implemented yet. | |
1013 | -- Should perform other action ??? | |
1014 | ||
1015 | end Abort_Task; | |
1016 | ||
1017 | ---------------- | |
1018 | -- Check_Exit -- | |
1019 | ---------------- | |
1020 | ||
fbf5a39b | 1021 | -- Dummy version |
84481f76 RK |
1022 | |
1023 | function Check_Exit (Self_ID : ST.Task_ID) return Boolean is | |
1024 | begin | |
1025 | return Check_No_Locks (Self_ID); | |
1026 | end Check_Exit; | |
1027 | ||
1028 | -------------------- | |
1029 | -- Check_No_Locks -- | |
1030 | -------------------- | |
1031 | ||
1032 | function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean is | |
1033 | TLD : constant Access_Thread_Local_Data := Thread_Local_Data_Ptr; | |
fbf5a39b | 1034 | |
84481f76 RK |
1035 | begin |
1036 | return Self_ID = TLD.Self_ID | |
1037 | and then TLD.Lock_Prio_Level = 0; | |
1038 | end Check_No_Locks; | |
1039 | ||
1040 | ---------------------- | |
1041 | -- Environment_Task -- | |
1042 | ---------------------- | |
1043 | ||
1044 | function Environment_Task return Task_ID is | |
1045 | begin | |
1046 | return Environment_Task_ID; | |
1047 | end Environment_Task; | |
1048 | ||
07fc65c4 GB |
1049 | -------------- |
1050 | -- Lock_RTS -- | |
1051 | -------------- | |
84481f76 | 1052 | |
07fc65c4 | 1053 | procedure Lock_RTS is |
84481f76 | 1054 | begin |
07fc65c4 GB |
1055 | Write_Lock (Single_RTS_Lock'Access, Global_Lock => True); |
1056 | end Lock_RTS; | |
84481f76 | 1057 | |
07fc65c4 GB |
1058 | ---------------- |
1059 | -- Unlock_RTS -- | |
1060 | ---------------- | |
84481f76 | 1061 | |
07fc65c4 | 1062 | procedure Unlock_RTS is |
84481f76 | 1063 | begin |
07fc65c4 GB |
1064 | Unlock (Single_RTS_Lock'Access, Global_Lock => True); |
1065 | end Unlock_RTS; | |
84481f76 RK |
1066 | |
1067 | ------------------ | |
1068 | -- Suspend_Task -- | |
1069 | ------------------ | |
1070 | ||
1071 | function Suspend_Task | |
1072 | (T : ST.Task_ID; | |
fbf5a39b AC |
1073 | Thread_Self : Thread_Id) |
1074 | return Boolean | |
1075 | is | |
84481f76 RK |
1076 | begin |
1077 | if Thread_Id (T.Common.LL.Thread) /= Thread_Self then | |
1078 | return DosSuspendThread (T.Common.LL.Thread) = NO_ERROR; | |
1079 | else | |
1080 | return True; | |
1081 | end if; | |
1082 | end Suspend_Task; | |
1083 | ||
1084 | ----------------- | |
1085 | -- Resume_Task -- | |
1086 | ----------------- | |
1087 | ||
1088 | function Resume_Task | |
1089 | (T : ST.Task_ID; | |
fbf5a39b AC |
1090 | Thread_Self : Thread_Id) |
1091 | return Boolean | |
1092 | is | |
84481f76 RK |
1093 | begin |
1094 | if Thread_Id (T.Common.LL.Thread) /= Thread_Self then | |
1095 | return DosResumeThread (T.Common.LL.Thread) = NO_ERROR; | |
1096 | else | |
1097 | return True; | |
1098 | end if; | |
1099 | end Resume_Task; | |
1100 | ||
1101 | ---------------- | |
1102 | -- Initialize -- | |
1103 | ---------------- | |
1104 | ||
1105 | procedure Initialize (Environment_Task : Task_ID) is | |
1106 | Succeeded : Boolean; | |
84481f76 RK |
1107 | begin |
1108 | Environment_Task_ID := Environment_Task; | |
1109 | ||
07fc65c4 | 1110 | Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level); |
84481f76 RK |
1111 | -- Initialize the lock used to synchronize chain of all ATCBs. |
1112 | ||
1113 | -- Set ID of environment task. | |
1114 | ||
1115 | Thread_Local_Data_Ptr.Self_ID := Environment_Task; | |
1116 | Environment_Task.Common.LL.Thread := 1; -- By definition | |
1117 | ||
1118 | -- This priority is unknown in fact. | |
1119 | -- If actual current priority is different, | |
1120 | -- it will get synchronized later on anyway. | |
1121 | ||
1122 | Environment_Task.Common.LL.Current_Priority := | |
1123 | Environment_Task.Common.Current_Priority; | |
1124 | ||
1125 | -- Initialize TCB for this task. | |
1126 | -- This includes all the normal task-external initialization. | |
1127 | -- This is also done by Initialize_ATCB, why ??? | |
1128 | ||
1129 | Initialize_TCB (Environment_Task, Succeeded); | |
1130 | ||
1131 | -- Consider raising Storage_Error, | |
1132 | -- if propagation can be tolerated ??? | |
1133 | ||
1134 | pragma Assert (Succeeded); | |
1135 | ||
1136 | -- Do normal task-internal initialization, | |
1137 | -- which depends on an initialized TCB. | |
1138 | ||
1139 | Enter_Task (Environment_Task); | |
1140 | ||
1141 | -- Insert here any other special | |
1142 | -- initialization needed for the environment task. | |
84481f76 RK |
1143 | end Initialize; |
1144 | ||
1145 | begin | |
1146 | -- Initialize pointer to task local data. | |
1147 | -- This is done once, for all tasks. | |
1148 | ||
1149 | Must_Not_Fail (DosAllocThreadLocalMemory | |
1150 | ((Thread_Local_Data'Size + 31) / 32, -- nr of 32-bit words | |
1151 | To_PPVOID (Thread_Local_Data_Ptr'Access))); | |
1152 | ||
1153 | -- Initialize thread local data for main thread | |
1154 | ||
1155 | Thread_Local_Data_Ptr.Self_ID := null; | |
1156 | Thread_Local_Data_Ptr.Lock_Prio_Level := 0; | |
84481f76 | 1157 | end System.Task_Primitives.Operations; |