gcc/ada/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-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
  37 pragma 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
  41 package 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
 551 end System.Task_Primitives.Operations;