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