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-- S p e c -- 8-- -- 9-- Copyright (C) 1992-2019, Free Software Foundation, Inc. -- 10-- -- 11-- GNARL is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- 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/>. -- 26-- -- 27-- GNARL was developed by the GNARL team at Florida State University. -- 28-- Extensive contributions were provided by Ada Core Technologies, Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32-- This package contains all the GNULL primitives that interface directly with 33-- the underlying OS. 34 35with System.Parameters; 36with System.Tasking; 37with System.OS_Interface; 38 39package System.Task_Primitives.Operations is 40 pragma Preelaborate; 41 42 package ST renames System.Tasking; 43 package OSI renames System.OS_Interface; 44 45 procedure Initialize (Environment_Task : ST.Task_Id); 46 -- Perform initialization and set up of the environment task for proper 47 -- operation of the tasking run-time. This must be called once, before any 48 -- other subprograms of this package are called. 49 50 procedure Create_Task 51 (T : ST.Task_Id; 52 Wrapper : System.Address; 53 Stack_Size : System.Parameters.Size_Type; 54 Priority : System.Any_Priority; 55 Succeeded : out Boolean); 56 pragma Inline (Create_Task); 57 -- Create a new low-level task with ST.Task_Id T and place other needed 58 -- information in the ATCB. 59 -- 60 -- A new thread of control is created, with a stack of at least Stack_Size 61 -- storage units, and the procedure Wrapper is called by this new thread 62 -- of control. If Stack_Size = Unspecified_Storage_Size, choose a default 63 -- stack size; this may be effectively "unbounded" on some systems. 64 -- 65 -- The newly created low-level task is associated with the ST.Task_Id T 66 -- such that any subsequent call to Self from within the context of the 67 -- low-level task returns T. 68 -- 69 -- The caller is responsible for ensuring that the storage of the Ada 70 -- task control block object pointed to by T persists for the lifetime 71 -- of the new task. 72 -- 73 -- Succeeded is set to true unless creation of the task failed, 74 -- as it may if there are insufficient resources to create another task. 75 76 procedure Enter_Task (Self_ID : ST.Task_Id); 77 pragma Inline (Enter_Task); 78 -- Initialize data structures specific to the calling task. Self must be 79 -- the ID of the calling task. It must be called (once) by the task 80 -- immediately after creation, while abort is still deferred. The effects 81 -- of other operations defined below are not defined unless the caller has 82 -- previously called Initialize_Task. 83 84 procedure Exit_Task; 85 pragma Inline (Exit_Task); 86 -- Destroy the thread of control. Self must be the ID of the calling task. 87 -- The effects of further calls to operations defined below on the task 88 -- are undefined thereafter. 89 90 ---------------------------------- 91 -- ATCB allocation/deallocation -- 92 ---------------------------------- 93 94 package ATCB_Allocation is 95 96 function New_ATCB (Entry_Num : ST.Task_Entry_Index) return ST.Task_Id; 97 pragma Inline (New_ATCB); 98 -- Allocate a new ATCB with the specified number of entries 99 100 procedure Free_ATCB (T : ST.Task_Id); 101 pragma Inline (Free_ATCB); 102 -- Deallocate an ATCB previously allocated by New_ATCB 103 104 end ATCB_Allocation; 105 106 function New_ATCB (Entry_Num : ST.Task_Entry_Index) return ST.Task_Id 107 renames ATCB_Allocation.New_ATCB; 108 109 procedure Initialize_TCB (Self_ID : ST.Task_Id; Succeeded : out Boolean); 110 pragma Inline (Initialize_TCB); 111 -- Initialize all fields of the TCB 112 113 procedure Finalize_TCB (T : ST.Task_Id); 114 pragma Inline (Finalize_TCB); 115 -- Finalizes Private_Data of ATCB, and then deallocates it. This is also 116 -- responsible for recovering any storage or other resources that were 117 -- allocated by Create_Task (the one in this package). This should only be 118 -- called from Free_Task. After it is called there should be no further 119 -- reference to the ATCB that corresponds to T. 120 121 procedure Abort_Task (T : ST.Task_Id); 122 pragma Inline (Abort_Task); 123 -- Abort the task specified by T (the target task). This causes the target 124 -- task to asynchronously raise Abort_Signal if abort is not deferred, or 125 -- if it is blocked on an interruptible system call. 126 -- 127 -- precondition: 128 -- the calling task is holding T's lock and has abort deferred 129 -- 130 -- postcondition: 131 -- the calling task is holding T's lock and has abort deferred. 132 133 -- ??? modify GNARL to skip wakeup and always call Abort_Task 134 135 function Self return ST.Task_Id; 136 pragma Inline (Self); 137 -- Return a pointer to the Ada Task Control Block of the calling task 138 139 type Lock_Level is 140 (PO_Level, 141 Global_Task_Level, 142 RTS_Lock_Level, 143 ATCB_Level); 144 -- Type used to describe kind of lock for second form of Initialize_Lock 145 -- call specified below. See locking rules in System.Tasking (spec) for 146 -- more details. 147 148 procedure Initialize_Lock 149 (Prio : System.Any_Priority; 150 L : not null access Lock); 151 procedure Initialize_Lock 152 (L : not null access RTS_Lock; 153 Level : Lock_Level); 154 pragma Inline (Initialize_Lock); 155 -- Initialize a lock object 156 -- 157 -- For Lock, Prio is the ceiling priority associated with the lock. For 158 -- RTS_Lock, the ceiling is implicitly Priority'Last. 159 -- 160 -- If the underlying system does not support priority ceiling 161 -- locking, the Prio parameter is ignored. 162 -- 163 -- The effect of either initialize operation is undefined unless is a lock 164 -- object that has not been initialized, or which has been finalized since 165 -- it was last initialized. 166 -- 167 -- The effects of the other operations on lock objects are undefined 168 -- unless the lock object has been initialized and has not since been 169 -- finalized. 170 -- 171 -- Initialization of the per-task lock is implicit in Create_Task 172 -- 173 -- These operations raise Storage_Error if a lack of storage is detected 174 175 procedure Finalize_Lock (L : not null access Lock); 176 procedure Finalize_Lock (L : not null access RTS_Lock); 177 pragma Inline (Finalize_Lock); 178 -- Finalize a lock object, freeing any resources allocated by the 179 -- corresponding Initialize_Lock operation. 180 181 procedure Write_Lock 182 (L : not null access Lock; 183 Ceiling_Violation : out Boolean); 184 procedure Write_Lock 185 (L : not null access RTS_Lock; 186 Global_Lock : Boolean := False); 187 procedure Write_Lock 188 (T : ST.Task_Id); 189 pragma Inline (Write_Lock); 190 -- Lock a lock object for write access. After this operation returns, 191 -- the calling task holds write permission for the lock object. No other 192 -- Write_Lock or Read_Lock operation on the same lock object will return 193 -- until this task executes an Unlock operation on the same object. The 194 -- effect is undefined if the calling task already holds read or write 195 -- permission for the lock object L. 196 -- 197 -- For the operation on Lock, Ceiling_Violation is set to true iff the 198 -- operation failed, which will happen if there is a priority ceiling 199 -- violation. 200 -- 201 -- For the operation on RTS_Lock, Global_Lock should be set to True 202 -- if L is a global lock (Single_RTS_Lock, Global_Task_Lock). 203 -- 204 -- For the operation on ST.Task_Id, the lock is the special lock object 205 -- associated with that task's ATCB. This lock has effective ceiling 206 -- priority high enough that it is safe to call by a task with any 207 -- priority in the range System.Priority. It is implicitly initialized 208 -- by task creation. The effect is undefined if the calling task already 209 -- holds T's lock, or has interrupt-level priority. Finalization of the 210 -- per-task lock is implicit in Exit_Task. 211 212 procedure Read_Lock 213 (L : not null access Lock; 214 Ceiling_Violation : out Boolean); 215 pragma Inline (Read_Lock); 216 -- Lock a lock object for read access. After this operation returns, 217 -- the calling task has non-exclusive read permission for the logical 218 -- resources that are protected by the lock. No other Write_Lock operation 219 -- on the same object will return until this task and any other tasks with 220 -- read permission for this lock have executed Unlock operation(s) on the 221 -- lock object. A Read_Lock for a lock object may return immediately while 222 -- there are tasks holding read permission, provided there are no tasks 223 -- holding write permission for the object. The effect is undefined if 224 -- the calling task already holds read or write permission for L. 225 -- 226 -- Alternatively: An implementation may treat Read_Lock identically to 227 -- Write_Lock. This simplifies the implementation, but reduces the level 228 -- of concurrency that can be achieved. 229 -- 230 -- Note that Read_Lock is not defined for RT_Lock and ST.Task_Id. 231 -- That is because (1) so far Read_Lock has always been implemented 232 -- the same as Write_Lock, (2) most lock usage inside the RTS involves 233 -- potential write access, and (3) implementations of priority ceiling 234 -- locking that make a reader-writer distinction have higher overhead. 235 236 procedure Unlock 237 (L : not null access Lock); 238 procedure Unlock 239 (L : not null access RTS_Lock; 240 Global_Lock : Boolean := False); 241 procedure Unlock 242 (T : ST.Task_Id); 243 pragma Inline (Unlock); 244 -- Unlock a locked lock object 245 -- 246 -- The effect is undefined unless the calling task holds read or write 247 -- permission for the lock L, and L is the lock object most recently 248 -- locked by the calling task for which the calling task still holds 249 -- read or write permission. (That is, matching pairs of Lock and Unlock 250 -- operations on each lock object must be properly nested.) 251 252 -- For the operation on RTS_Lock, Global_Lock should be set to True if L 253 -- is a global lock (Single_RTS_Lock, Global_Task_Lock). 254 -- 255 -- Note that Write_Lock for RTS_Lock does not have an out-parameter. 256 -- RTS_Locks are used in situations where we have not made provision for 257 -- recovery from ceiling violations. We do not expect them to occur inside 258 -- the runtime system, because all RTS locks have ceiling Priority'Last. 259 260 -- There is one way there can be a ceiling violation. That is if the 261 -- runtime system is called from a task that is executing in the 262 -- Interrupt_Priority range. 263 264 -- It is not clear what to do about ceiling violations due to RTS calls 265 -- done at interrupt priority. In general, it is not acceptable to give 266 -- all RTS locks interrupt priority, since that would give terrible 267 -- performance on systems where this has the effect of masking hardware 268 -- interrupts, though we could get away allowing Interrupt_Priority'last 269 -- where we are layered on an OS that does not allow us to mask interrupts. 270 -- Ideally, we would like to raise Program_Error back at the original point 271 -- of the RTS call, but this would require a lot of detailed analysis and 272 -- recoding, with almost certain performance penalties. 273 274 -- For POSIX systems, we considered just skipping setting priority ceiling 275 -- on RTS locks. This would mean there is no ceiling violation, but we 276 -- would end up with priority inversions inside the runtime system, 277 -- resulting in failure to satisfy the Ada priority rules, and possible 278 -- missed validation tests. This could be compensated-for by explicit 279 -- priority-change calls to raise the caller to Priority'Last whenever it 280 -- first enters the runtime system, but the expected overhead seems high, 281 -- though it might be lower than using locks with ceilings if the 282 -- underlying implementation of ceiling locks is an inefficient one. 283 284 -- This issue should be reconsidered whenever we get around to checking 285 -- for calls to potentially blocking operations from within protected 286 -- operations. If we check for such calls and catch them on entry to the 287 -- OS, it may be that we can eliminate the possibility of ceiling 288 -- violations inside the RTS. For this to work, we would have to forbid 289 -- explicitly setting the priority of a task to anything in the 290 -- Interrupt_Priority range, at least. We would also have to check that 291 -- there are no RTS-lock operations done inside any operations that are 292 -- not treated as potentially blocking. 293 294 -- The latter approach seems to be the best, i.e. to check on entry to RTS 295 -- calls that may need to use locks that the priority is not in the 296 -- interrupt range. If there are RTS operations that NEED to be called 297 -- from interrupt handlers, those few RTS locks should then be converted 298 -- to PO-type locks, with ceiling Interrupt_Priority'Last. 299 300 -- For now, we will just shut down the system if there is ceiling violation 301 302 procedure Set_Ceiling 303 (L : not null access Lock; 304 Prio : System.Any_Priority); 305 pragma Inline (Set_Ceiling); 306 -- Change the ceiling priority associated to the lock 307 -- 308 -- The effect is undefined unless the calling task holds read or write 309 -- permission for the lock L, and L is the lock object most recently 310 -- locked by the calling task for which the calling task still holds 311 -- read or write permission. (That is, matching pairs of Lock and Unlock 312 -- operations on each lock object must be properly nested.) 313 314 procedure Yield (Do_Yield : Boolean := True); 315 pragma Inline (Yield); 316 -- Yield the processor. Add the calling task to the tail of the ready queue 317 -- for its active_priority. On most platforms, Yield is a no-op if Do_Yield 318 -- is False. But on some platforms (notably VxWorks), Do_Yield is ignored. 319 -- This is only used in some very rare cases where a Yield should have an 320 -- effect on a specific target and not on regular ones. 321 322 procedure Set_Priority 323 (T : ST.Task_Id; 324 Prio : System.Any_Priority; 325 Loss_Of_Inheritance : Boolean := False); 326 pragma Inline (Set_Priority); 327 -- Set the priority of the task specified by T to Prio. The priority set 328 -- is what would correspond to the Ada concept of "base priority" in the 329 -- terms of the lower layer system, but the operation may be used by the 330 -- upper layer to implement changes in "active priority" that are not due 331 -- to lock effects. The effect should be consistent with the Ada Reference 332 -- Manual. In particular, when a task lowers its priority due to the loss 333 -- of inherited priority, it goes at the head of the queue for its new 334 -- priority (RM D.2.2 par 9). Loss_Of_Inheritance helps the underlying 335 -- implementation to do it right when the OS doesn't. 336 337 function Get_Priority (T : ST.Task_Id) return System.Any_Priority; 338 pragma Inline (Get_Priority); 339 -- Returns the priority last set by Set_Priority for this task 340 341 function Monotonic_Clock return Duration; 342 pragma Inline (Monotonic_Clock); 343 -- Returns "absolute" time, represented as an offset relative to an 344 -- unspecified Epoch. This clock implementation is immune to the 345 -- system's clock changes. 346 347 function RT_Resolution return Duration; 348 pragma Inline (RT_Resolution); 349 -- Returns resolution of the underlying clock used to implement RT_Clock 350 351 ---------------- 352 -- Extensions -- 353 ---------------- 354 355 -- Whoever calls either of the Sleep routines is responsible for checking 356 -- for pending aborts before the call. Pending priority changes are handled 357 -- internally. 358 359 procedure Sleep 360 (Self_ID : ST.Task_Id; 361 Reason : System.Tasking.Task_States); 362 pragma Inline (Sleep); 363 -- Wait until the current task, T, is signaled to wake up 364 -- 365 -- precondition: 366 -- The calling task is holding its own ATCB lock 367 -- and has abort deferred 368 -- 369 -- postcondition: 370 -- The calling task is holding its own ATCB lock and has abort deferred. 371 372 -- The effect is to atomically unlock T's lock and wait, so that another 373 -- task that is able to lock T's lock can be assured that the wait has 374 -- actually commenced, and that a Wakeup operation will cause the waiting 375 -- task to become ready for execution once again. When Sleep returns, the 376 -- waiting task will again hold its own ATCB lock. The waiting task may 377 -- become ready for execution at any time (that is, spurious wakeups are 378 -- permitted), but it will definitely become ready for execution when a 379 -- Wakeup operation is performed for the same task. 380 381 procedure Timed_Sleep 382 (Self_ID : ST.Task_Id; 383 Time : Duration; 384 Mode : ST.Delay_Modes; 385 Reason : System.Tasking.Task_States; 386 Timedout : out Boolean; 387 Yielded : out Boolean); 388 -- Combination of Sleep (above) and Timed_Delay 389 390 procedure Timed_Delay 391 (Self_ID : ST.Task_Id; 392 Time : Duration; 393 Mode : ST.Delay_Modes); 394 -- Implement the semantics of the delay statement. 395 -- The caller should be abort-deferred and should not hold any locks. 396 397 procedure Wakeup 398 (T : ST.Task_Id; 399 Reason : System.Tasking.Task_States); 400 pragma Inline (Wakeup); 401 -- Wake up task T if it is waiting on a Sleep call (of ordinary 402 -- or timed variety), making it ready for execution once again. 403 -- If the task T is not waiting on a Sleep, the operation has no effect. 404 405 function Environment_Task return ST.Task_Id; 406 pragma Inline (Environment_Task); 407 -- Return the task ID of the environment task 408 -- Consider putting this into a variable visible directly 409 -- by the rest of the runtime system. ??? 410 411 function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id; 412 -- Return the thread id of the specified task 413 414 function Is_Valid_Task return Boolean; 415 pragma Inline (Is_Valid_Task); 416 -- Does the calling thread have an ATCB? 417 418 function Register_Foreign_Thread return ST.Task_Id; 419 -- Allocate and initialize a new ATCB for the current thread 420 421 ----------------------- 422 -- RTS Entrance/Exit -- 423 ----------------------- 424 425 -- Following two routines are used for possible operations needed to be 426 -- setup/cleared upon entrance/exit of RTS while maintaining a single 427 -- thread of control in the RTS. Since we intend these routines to be used 428 -- for implementing the Single_Lock RTS, Lock_RTS should follow the first 429 -- Defer_Abort operation entering RTS. In the same fashion Unlock_RTS 430 -- should precede the last Undefer_Abort exiting RTS. 431 -- 432 -- These routines also replace the functions Lock/Unlock_All_Tasks_List 433 434 procedure Lock_RTS; 435 -- Take the global RTS lock 436 437 procedure Unlock_RTS; 438 -- Release the global RTS lock 439 440 -------------------- 441 -- Stack Checking -- 442 -------------------- 443 444 -- Stack checking in GNAT is done using the concept of stack probes. A 445 -- stack probe is an operation that will generate a storage error if 446 -- an insufficient amount of stack space remains in the current task. 447 448 -- The exact mechanism for a stack probe is target dependent. Typical 449 -- possibilities are to use a load from a non-existent page, a store to a 450 -- read-only page, or a comparison with some stack limit constant. Where 451 -- possible we prefer to use a trap on a bad page access, since this has 452 -- less overhead. The generation of stack probes is either automatic if 453 -- the ABI requires it (as on for example DEC Unix), or is controlled by 454 -- the gcc parameter -fstack-check. 455 456 -- When we are using bad-page accesses, we need a bad page, called guard 457 -- page, at the end of each task stack. On some systems, this is provided 458 -- automatically, but on other systems, we need to create the guard page 459 -- ourselves, and the procedure Stack_Guard is provided for this purpose. 460 461 procedure Stack_Guard (T : ST.Task_Id; On : Boolean); 462 -- Ensure guard page is set if one is needed and the underlying thread 463 -- system does not provide it. The procedure is as follows: 464 -- 465 -- 1. When we create a task adjust its size so a guard page can 466 -- safely be set at the bottom of the stack. 467 -- 468 -- 2. When the thread is created (and its stack allocated by the 469 -- underlying thread system), get the stack base (and size, depending 470 -- how the stack is growing), and create the guard page taking care 471 -- of page boundaries issues. 472 -- 473 -- 3. When the task is destroyed, remove the guard page. 474 -- 475 -- If On is true then protect the stack bottom (i.e make it read only) 476 -- else unprotect it (i.e. On is True for the call when creating a task, 477 -- and False when a task is destroyed). 478 -- 479 -- The call to Stack_Guard has no effect if guard pages are not used on 480 -- the target, or if guard pages are automatically provided by the system. 481 482 ------------------------ 483 -- Suspension objects -- 484 ------------------------ 485 486 -- These subprograms provide the functionality required for synchronizing 487 -- on a suspension object. Tasks can suspend execution and relinquish the 488 -- processors until the condition is signaled. 489 490 function Current_State (S : Suspension_Object) return Boolean; 491 -- Return the state of the suspension object 492 493 procedure Set_False (S : in out Suspension_Object); 494 -- Set the state of the suspension object to False 495 496 procedure Set_True (S : in out Suspension_Object); 497 -- Set the state of the suspension object to True. If a task were 498 -- suspended on the protected object then this task is released (and 499 -- the state of the suspension object remains set to False). 500 501 procedure Suspend_Until_True (S : in out Suspension_Object); 502 -- If the state of the suspension object is True then the calling task 503 -- continues its execution, and the state is set to False. If the state 504 -- of the object is False then the task is suspended on the suspension 505 -- object until a Set_True operation is executed. Program_Error is raised 506 -- if another task is already waiting on that suspension object. 507 508 procedure Initialize (S : in out Suspension_Object); 509 -- Initialize the suspension object 510 511 procedure Finalize (S : in out Suspension_Object); 512 -- Finalize the suspension object 513 514 ----------------------------------------- 515 -- Runtime System Debugging Interfaces -- 516 ----------------------------------------- 517 518 -- These interfaces have been added to assist in debugging the 519 -- tasking runtime system. 520 521 function Check_Exit (Self_ID : ST.Task_Id) return Boolean; 522 pragma Inline (Check_Exit); 523 -- Check that the current task is holding only Global_Task_Lock 524 525 function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean; 526 pragma Inline (Check_No_Locks); 527 -- Check that current task is holding no locks 528 529 function Suspend_Task 530 (T : ST.Task_Id; 531 Thread_Self : OSI.Thread_Id) return Boolean; 532 -- Suspend a specific task when the underlying thread library provides this 533 -- functionality, unless the thread associated with T is Thread_Self. Such 534 -- functionality is needed by gdb on some targets (e.g VxWorks) Return True 535 -- is the operation is successful. On targets where this operation is not 536 -- available, a dummy body is present which always returns False. 537 538 function Resume_Task 539 (T : ST.Task_Id; 540 Thread_Self : OSI.Thread_Id) return Boolean; 541 -- Resume a specific task when the underlying thread library provides 542 -- such functionality, unless the thread associated with T is Thread_Self. 543 -- Such functionality is needed by gdb on some targets (e.g VxWorks) 544 -- Return True is the operation is successful 545 546 procedure Stop_All_Tasks; 547 -- Stop all tasks when the underlying thread library provides such 548 -- functionality. Such functionality is needed by gdb on some targets (e.g 549 -- VxWorks) This function can be run from an interrupt handler. Return True 550 -- is the operation is successful 551 552 function Stop_Task (T : ST.Task_Id) return Boolean; 553 -- Stop a specific task when the underlying thread library provides 554 -- such functionality. Such functionality is needed by gdb on some targets 555 -- (e.g VxWorks). Return True is the operation is successful. 556 557 function Continue_Task (T : ST.Task_Id) return Boolean; 558 -- Continue a specific task when the underlying thread library provides 559 -- such functionality. Such functionality is needed by gdb on some targets 560 -- (e.g VxWorks) Return True is the operation is successful 561 562 ------------------- 563 -- Task affinity -- 564 ------------------- 565 566 procedure Set_Task_Affinity (T : ST.Task_Id); 567 -- Enforce at the operating system level the task affinity defined in the 568 -- Ada Task Control Block. Has no effect if the underlying operating system 569 -- does not support this capability. 570 571end System.Task_Primitives.Operations; 572