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