1------------------------------------------------------------------------------ 2-- -- 3-- GNAT 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-- -- 9-- Copyright (C) 1992-2012, 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 is a no tasking version of this package 33 34-- This package contains all the GNULL primitives that interface directly with 35-- the underlying OS. 36 37pragma Polling (Off); 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 41package body System.Task_Primitives.Operations is 42 43 use System.Tasking; 44 use System.Parameters; 45 46 pragma Warnings (Off); 47 -- Turn off warnings since so many unreferenced parameters 48 49 -------------- 50 -- Specific -- 51 -------------- 52 53 -- Package Specific contains target specific routines, and the body of 54 -- this package is target specific. 55 56 package Specific is 57 procedure Set (Self_Id : Task_Id); 58 pragma Inline (Set); 59 -- Set the self id for the current task 60 end Specific; 61 62 package body Specific is 63 64 --------- 65 -- Set -- 66 --------- 67 68 procedure Set (Self_Id : Task_Id) is 69 begin 70 null; 71 end Set; 72 end Specific; 73 74 ---------------------------------- 75 -- ATCB allocation/deallocation -- 76 ---------------------------------- 77 78 package body ATCB_Allocation is separate; 79 -- The body of this package is shared across several targets 80 81 ---------------- 82 -- Abort_Task -- 83 ---------------- 84 85 procedure Abort_Task (T : Task_Id) is 86 begin 87 null; 88 end Abort_Task; 89 90 ---------------- 91 -- Check_Exit -- 92 ---------------- 93 94 function Check_Exit (Self_ID : ST.Task_Id) return Boolean is 95 begin 96 return True; 97 end Check_Exit; 98 99 -------------------- 100 -- Check_No_Locks -- 101 -------------------- 102 103 function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is 104 begin 105 return True; 106 end Check_No_Locks; 107 108 ------------------- 109 -- Continue_Task -- 110 ------------------- 111 112 function Continue_Task (T : ST.Task_Id) return Boolean is 113 begin 114 return False; 115 end Continue_Task; 116 117 ------------------- 118 -- Current_State -- 119 ------------------- 120 121 function Current_State (S : Suspension_Object) return Boolean is 122 begin 123 return False; 124 end Current_State; 125 126 ---------------------- 127 -- Environment_Task -- 128 ---------------------- 129 130 function Environment_Task return Task_Id is 131 begin 132 return null; 133 end Environment_Task; 134 135 ----------------- 136 -- Create_Task -- 137 ----------------- 138 139 procedure Create_Task 140 (T : Task_Id; 141 Wrapper : System.Address; 142 Stack_Size : System.Parameters.Size_Type; 143 Priority : System.Any_Priority; 144 Succeeded : out Boolean) 145 is 146 begin 147 Succeeded := False; 148 end Create_Task; 149 150 ---------------- 151 -- Enter_Task -- 152 ---------------- 153 154 procedure Enter_Task (Self_ID : Task_Id) is 155 begin 156 null; 157 end Enter_Task; 158 159 --------------- 160 -- Exit_Task -- 161 --------------- 162 163 procedure Exit_Task is 164 begin 165 null; 166 end Exit_Task; 167 168 -------------- 169 -- Finalize -- 170 -------------- 171 172 procedure Finalize (S : in out Suspension_Object) is 173 begin 174 null; 175 end Finalize; 176 177 ------------------- 178 -- Finalize_Lock -- 179 ------------------- 180 181 procedure Finalize_Lock (L : not null access Lock) is 182 begin 183 null; 184 end Finalize_Lock; 185 186 procedure Finalize_Lock (L : not null access RTS_Lock) is 187 begin 188 null; 189 end Finalize_Lock; 190 191 ------------------ 192 -- Finalize_TCB -- 193 ------------------ 194 195 procedure Finalize_TCB (T : Task_Id) is 196 begin 197 null; 198 end Finalize_TCB; 199 200 ------------------ 201 -- Get_Priority -- 202 ------------------ 203 204 function Get_Priority (T : Task_Id) return System.Any_Priority is 205 begin 206 return 0; 207 end Get_Priority; 208 209 -------------------- 210 -- Get_Thread_Id -- 211 -------------------- 212 213 function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is 214 begin 215 return OSI.Thread_Id (T.Common.LL.Thread); 216 end Get_Thread_Id; 217 218 ---------------- 219 -- Initialize -- 220 ---------------- 221 222 procedure Initialize (Environment_Task : Task_Id) is 223 No_Tasking : Boolean; 224 begin 225 raise Program_Error with "tasking not implemented on this configuration"; 226 end Initialize; 227 228 procedure Initialize (S : in out Suspension_Object) is 229 begin 230 null; 231 end Initialize; 232 233 --------------------- 234 -- Initialize_Lock -- 235 --------------------- 236 237 procedure Initialize_Lock 238 (Prio : System.Any_Priority; 239 L : not null access Lock) 240 is 241 begin 242 null; 243 end Initialize_Lock; 244 245 procedure Initialize_Lock 246 (L : not null access RTS_Lock; Level : Lock_Level) is 247 begin 248 null; 249 end Initialize_Lock; 250 251 -------------------- 252 -- Initialize_TCB -- 253 -------------------- 254 255 procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is 256 begin 257 Succeeded := False; 258 end Initialize_TCB; 259 260 ------------------- 261 -- Is_Valid_Task -- 262 ------------------- 263 264 function Is_Valid_Task return Boolean is 265 begin 266 return False; 267 end Is_Valid_Task; 268 269 -------------- 270 -- Lock_RTS -- 271 -------------- 272 273 procedure Lock_RTS is 274 begin 275 null; 276 end Lock_RTS; 277 278 --------------------- 279 -- Monotonic_Clock -- 280 --------------------- 281 282 function Monotonic_Clock return Duration is 283 begin 284 return 0.0; 285 end Monotonic_Clock; 286 287 --------------- 288 -- Read_Lock -- 289 --------------- 290 291 procedure Read_Lock 292 (L : not null access Lock; 293 Ceiling_Violation : out Boolean) 294 is 295 begin 296 Ceiling_Violation := False; 297 end Read_Lock; 298 299 ----------------------------- 300 -- Register_Foreign_Thread -- 301 ----------------------------- 302 303 function Register_Foreign_Thread return Task_Id is 304 begin 305 return null; 306 end Register_Foreign_Thread; 307 308 ----------------- 309 -- Resume_Task -- 310 ----------------- 311 312 function Resume_Task 313 (T : ST.Task_Id; 314 Thread_Self : OSI.Thread_Id) return Boolean 315 is 316 begin 317 return False; 318 end Resume_Task; 319 320 ------------------- 321 -- RT_Resolution -- 322 ------------------- 323 324 function RT_Resolution return Duration is 325 begin 326 return 10#1.0#E-6; 327 end RT_Resolution; 328 329 ---------- 330 -- Self -- 331 ---------- 332 333 function Self return Task_Id is 334 begin 335 return Null_Task; 336 end Self; 337 338 ----------------- 339 -- Set_Ceiling -- 340 ----------------- 341 342 procedure Set_Ceiling 343 (L : not null access Lock; 344 Prio : System.Any_Priority) 345 is 346 begin 347 null; 348 end Set_Ceiling; 349 350 --------------- 351 -- Set_False -- 352 --------------- 353 354 procedure Set_False (S : in out Suspension_Object) is 355 begin 356 null; 357 end Set_False; 358 359 ------------------ 360 -- Set_Priority -- 361 ------------------ 362 363 procedure Set_Priority 364 (T : Task_Id; 365 Prio : System.Any_Priority; 366 Loss_Of_Inheritance : Boolean := False) 367 is 368 begin 369 null; 370 end Set_Priority; 371 372 ----------------------- 373 -- Set_Task_Affinity -- 374 ----------------------- 375 376 procedure Set_Task_Affinity (T : ST.Task_Id) is 377 begin 378 null; 379 end Set_Task_Affinity; 380 381 -------------- 382 -- Set_True -- 383 -------------- 384 385 procedure Set_True (S : in out Suspension_Object) is 386 begin 387 null; 388 end Set_True; 389 390 ----------- 391 -- Sleep -- 392 ----------- 393 394 procedure Sleep (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is 395 begin 396 null; 397 end Sleep; 398 399 ----------------- 400 -- Stack_Guard -- 401 ----------------- 402 403 procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is 404 begin 405 null; 406 end Stack_Guard; 407 408 ------------------ 409 -- Suspend_Task -- 410 ------------------ 411 412 function Suspend_Task 413 (T : ST.Task_Id; 414 Thread_Self : OSI.Thread_Id) return Boolean 415 is 416 begin 417 return False; 418 end Suspend_Task; 419 420 -------------------- 421 -- Stop_All_Tasks -- 422 -------------------- 423 424 procedure Stop_All_Tasks is 425 begin 426 null; 427 end Stop_All_Tasks; 428 429 --------------- 430 -- Stop_Task -- 431 --------------- 432 433 function Stop_Task (T : ST.Task_Id) return Boolean is 434 pragma Unreferenced (T); 435 begin 436 return False; 437 end Stop_Task; 438 439 ------------------------ 440 -- Suspend_Until_True -- 441 ------------------------ 442 443 procedure Suspend_Until_True (S : in out Suspension_Object) is 444 begin 445 null; 446 end Suspend_Until_True; 447 448 ----------------- 449 -- Timed_Delay -- 450 ----------------- 451 452 procedure Timed_Delay 453 (Self_ID : Task_Id; 454 Time : Duration; 455 Mode : ST.Delay_Modes) 456 is 457 begin 458 null; 459 end Timed_Delay; 460 461 ----------------- 462 -- Timed_Sleep -- 463 ----------------- 464 465 procedure Timed_Sleep 466 (Self_ID : Task_Id; 467 Time : Duration; 468 Mode : ST.Delay_Modes; 469 Reason : System.Tasking.Task_States; 470 Timedout : out Boolean; 471 Yielded : out Boolean) 472 is 473 begin 474 Timedout := False; 475 Yielded := False; 476 end Timed_Sleep; 477 478 ------------ 479 -- Unlock -- 480 ------------ 481 482 procedure Unlock (L : not null access Lock) is 483 begin 484 null; 485 end Unlock; 486 487 procedure Unlock 488 (L : not null access RTS_Lock; 489 Global_Lock : Boolean := False) 490 is 491 begin 492 null; 493 end Unlock; 494 495 procedure Unlock (T : Task_Id) is 496 begin 497 null; 498 end Unlock; 499 500 ---------------- 501 -- Unlock_RTS -- 502 ---------------- 503 504 procedure Unlock_RTS is 505 begin 506 null; 507 end Unlock_RTS; 508 ------------ 509 -- Wakeup -- 510 ------------ 511 512 procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is 513 begin 514 null; 515 end Wakeup; 516 517 ---------------- 518 -- Write_Lock -- 519 ---------------- 520 521 procedure Write_Lock 522 (L : not null access Lock; 523 Ceiling_Violation : out Boolean) 524 is 525 begin 526 Ceiling_Violation := False; 527 end Write_Lock; 528 529 procedure Write_Lock 530 (L : not null access RTS_Lock; 531 Global_Lock : Boolean := False) 532 is 533 begin 534 null; 535 end Write_Lock; 536 537 procedure Write_Lock (T : Task_Id) is 538 begin 539 null; 540 end Write_Lock; 541 542 ----------- 543 -- Yield -- 544 ----------- 545 546 procedure Yield (Do_Yield : Boolean := True) is 547 begin 548 null; 549 end Yield; 550 551end System.Task_Primitives.Operations; 552