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