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