gcc/ada/s-taprop-dummy.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                GNU ADA 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-2004, 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,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, 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.Tasking;
  44 --  used for Ada_Task_Control_Block
  45 --           Task_Id
  46
  47 with System.Error_Reporting;
  48 --  used for Shutdown
  49
  50 package body System.Task_Primitives.Operations is
  51
  52    use System.Tasking;
  53    use System.Parameters;
  54
  55    pragma Warnings (Off);
  56    --  Turn off warnings since so many unreferenced parameters
  57
  58    No_Tasking : Boolean;
  59    --  Comment required here ???
  60
  61    ----------------
  62    -- Abort_Task --
  63    ----------------
  64
  65    procedure Abort_Task (T : Task_Id) is
  66    begin
  67       null;
  68    end Abort_Task;
  69
  70    ----------------
  71    -- Check_Exit --
  72    ----------------
  73
  74    --  Dummy version
  75
  76    function Check_Exit (Self_ID : ST.Task_Id) return Boolean is
  77    begin
  78       return True;
  79    end Check_Exit;
  80
  81    --------------------
  82    -- Check_No_Locks --
  83    --------------------
  84
  85    function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is
  86    begin
  87       return True;
  88    end Check_No_Locks;
  89
  90    ----------------------
  91    -- Environment_Task --
  92    ----------------------
  93
  94    function Environment_Task return Task_Id is
  95    begin
  96       return null;
  97    end Environment_Task;
  98
  99    -----------------
 100    -- Create_Task --
 101    -----------------
 102
 103    procedure Create_Task
 104      (T          : Task_Id;
 105       Wrapper    : System.Address;
 106       Stack_Size : System.Parameters.Size_Type;
 107       Priority   : System.Any_Priority;
 108       Succeeded  : out Boolean)
 109    is
 110    begin
 111       Succeeded := False;
 112    end Create_Task;
 113
 114    ----------------
 115    -- Enter_Task --
 116    ----------------
 117
 118    procedure Enter_Task (Self_ID : Task_Id) is
 119    begin
 120       null;
 121    end Enter_Task;
 122
 123    ---------------
 124    -- Exit_Task --
 125    ---------------
 126
 127    procedure Exit_Task is
 128    begin
 129       null;
 130    end Exit_Task;
 131
 132    -------------------
 133    -- Finalize_Lock --
 134    -------------------
 135
 136    procedure Finalize_Lock (L : access Lock) is
 137    begin
 138       null;
 139    end Finalize_Lock;
 140
 141    procedure Finalize_Lock (L : access RTS_Lock) is
 142    begin
 143       null;
 144    end Finalize_Lock;
 145
 146    ------------------
 147    -- Finalize_TCB --
 148    ------------------
 149
 150    procedure Finalize_TCB (T : Task_Id) is
 151    begin
 152       null;
 153    end Finalize_TCB;
 154
 155    ------------------
 156    -- Get_Priority --
 157    ------------------
 158
 159    function Get_Priority (T : Task_Id) return System.Any_Priority is
 160    begin
 161       return 0;
 162    end Get_Priority;
 163
 164    --------------------
 165    -- Get_Thread_Id  --
 166    --------------------
 167
 168    function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is
 169    begin
 170       return OSI.Thread_Id (T.Common.LL.Thread);
 171    end Get_Thread_Id;
 172
 173    ----------------
 174    -- Initialize --
 175    ----------------
 176
 177    procedure Initialize (Environment_Task : Task_Id) is
 178    begin
 179       null;
 180    end Initialize;
 181
 182    ---------------------
 183    -- Initialize_Lock --
 184    ---------------------
 185
 186    procedure Initialize_Lock
 187      (Prio : System.Any_Priority;
 188       L    : access Lock)
 189    is
 190    begin
 191       null;
 192    end Initialize_Lock;
 193
 194    procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is
 195    begin
 196       null;
 197    end Initialize_Lock;
 198
 199    --------------------
 200    -- Initialize_TCB --
 201    --------------------
 202
 203    procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is
 204    begin
 205       Succeeded := False;
 206    end Initialize_TCB;
 207
 208    -------------------
 209    -- Is_Valid_Task --
 210    -------------------
 211
 212    function Is_Valid_Task return Boolean is
 213    begin
 214       return False;
 215    end Is_Valid_Task;
 216
 217    --------------
 218    -- Lock_RTS --
 219    --------------
 220
 221    procedure Lock_RTS is
 222    begin
 223       null;
 224    end Lock_RTS;
 225
 226    ---------------------
 227    -- Monotonic_Clock --
 228    ---------------------
 229
 230    function Monotonic_Clock return Duration is
 231    begin
 232       return 0.0;
 233    end Monotonic_Clock;
 234
 235    --------------
 236    -- New_ATCB --
 237    --------------
 238
 239    function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is
 240    begin
 241       return new Ada_Task_Control_Block (Entry_Num);
 242    end New_ATCB;
 243
 244    ---------------
 245    -- Read_Lock --
 246    ---------------
 247
 248    procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
 249    begin
 250       Ceiling_Violation := False;
 251    end Read_Lock;
 252
 253    -----------------------------
 254    -- Register_Foreign_Thread --
 255    -----------------------------
 256
 257    function Register_Foreign_Thread return Task_Id is
 258    begin
 259       return null;
 260    end Register_Foreign_Thread;
 261
 262    -----------------
 263    -- Resume_Task --
 264    -----------------
 265
 266    function Resume_Task
 267      (T           : ST.Task_Id;
 268       Thread_Self : OSI.Thread_Id) return Boolean
 269    is
 270    begin
 271       return False;
 272    end Resume_Task;
 273
 274    -------------------
 275    -- RT_Resolution --
 276    -------------------
 277
 278    function RT_Resolution return Duration is
 279    begin
 280       return 10#1.0#E-6;
 281    end RT_Resolution;
 282
 283    ----------
 284    -- Self --
 285    ----------
 286
 287    function Self return Task_Id is
 288    begin
 289       return Null_Task;
 290    end Self;
 291
 292    ------------------
 293    -- Set_Priority --
 294    ------------------
 295
 296    procedure Set_Priority
 297      (T                   : Task_Id;
 298       Prio                : System.Any_Priority;
 299       Loss_Of_Inheritance : Boolean := False)
 300    is
 301    begin
 302       null;
 303    end Set_Priority;
 304
 305    -----------
 306    -- Sleep --
 307    -----------
 308
 309    procedure Sleep (Self_ID : Task_Id; Reason  : System.Tasking.Task_States) is
 310    begin
 311       null;
 312    end Sleep;
 313
 314    -----------------
 315    -- Stack_Guard --
 316    -----------------
 317
 318    procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is
 319    begin
 320       null;
 321    end Stack_Guard;
 322
 323    ------------------
 324    -- Suspend_Task --
 325    ------------------
 326
 327    function Suspend_Task
 328      (T           : ST.Task_Id;
 329       Thread_Self : OSI.Thread_Id) return Boolean
 330    is
 331    begin
 332       return False;
 333    end Suspend_Task;
 334
 335    -----------------
 336    -- Timed_Delay --
 337    -----------------
 338
 339    procedure Timed_Delay
 340      (Self_ID : Task_Id;
 341       Time    : Duration;
 342       Mode    : ST.Delay_Modes)
 343    is
 344    begin
 345       null;
 346    end Timed_Delay;
 347
 348    -----------------
 349    -- Timed_Sleep --
 350    -----------------
 351
 352    procedure Timed_Sleep
 353      (Self_ID  : Task_Id;
 354       Time     : Duration;
 355       Mode     : ST.Delay_Modes;
 356       Reason   : System.Tasking.Task_States;
 357       Timedout : out Boolean;
 358       Yielded  : out Boolean)
 359    is
 360    begin
 361       Timedout := False;
 362       Yielded := False;
 363    end Timed_Sleep;
 364
 365    ------------
 366    -- Unlock --
 367    ------------
 368
 369    procedure Unlock (L : access Lock) is
 370    begin
 371       null;
 372    end Unlock;
 373
 374    procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
 375    begin
 376       null;
 377    end Unlock;
 378
 379    procedure Unlock (T : Task_Id) is
 380    begin
 381       null;
 382    end Unlock;
 383
 384    ----------------
 385    -- Unlock_RTS --
 386    ----------------
 387
 388    procedure Unlock_RTS is
 389    begin
 390       null;
 391    end Unlock_RTS;
 392    ------------
 393    -- Wakeup --
 394    ------------
 395
 396    procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is
 397    begin
 398       null;
 399    end Wakeup;
 400
 401    ----------------
 402    -- Write_Lock --
 403    ----------------
 404
 405    procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
 406    begin
 407       Ceiling_Violation := False;
 408    end Write_Lock;
 409
 410    procedure Write_Lock
 411      (L           : access RTS_Lock;
 412       Global_Lock : Boolean := False)
 413    is
 414    begin
 415       null;
 416    end Write_Lock;
 417
 418    procedure Write_Lock (T : Task_Id) is
 419    begin
 420       null;
 421    end Write_Lock;
 422
 423    -----------
 424    -- Yield --
 425    -----------
 426
 427    procedure Yield (Do_Yield : Boolean := True) is
 428    begin
 429       null;
 430    end Yield;
 431
 432 begin
 433    --  Can't raise an exception because target independent packages try to
 434    --  do an Abort_Defer, which gets a memory fault.
 435
 436    No_Tasking :=
 437      System.Error_Reporting.Shutdown
 438        ("Tasking not implemented on this configuration");
 439 end System.Task_Primitives.Operations;