gcc/ada/libgnarl/s-taprop__dummy.adb

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