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