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