gcc/ada/s-tasren.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
   4 --                                                                          --
   5 --             S Y S T E M . T A S K I N G . R E N D E Z V O U S            --
   6 --                                                                          --
   7 --                                  S p e c                                 --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2005, 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 --  Note: the compiler generates direct calls to this interface, via Rtsfind.
  35 --  Any changes to this interface may require corresponding compiler changes.
  36
  37 with Ada.Exceptions;
  38 --  Used for, Exception_Id
  39
  40 with System.Tasking.Protected_Objects.Entries;
  41 --  used for Protection_Entries
  42
  43 package System.Tasking.Rendezvous is
  44
  45    package STPE renames System.Tasking.Protected_Objects.Entries;
  46
  47    procedure Task_Entry_Call
  48      (Acceptor              : Task_Id;
  49       E                     : Task_Entry_Index;
  50       Uninterpreted_Data    : System.Address;
  51       Mode                  : Call_Modes;
  52       Rendezvous_Successful : out Boolean);
  53    --  General entry call used to implement ATC or conditional entry calls.
  54    --  Compiler interface only. Do not call from within the RTS.
  55    --  Acceptor is the ID of the acceptor task.
  56    --  E is the entry index requested.
  57    --  Uninterpreted_Data represents the parameters of the entry. It is
  58    --  constructed by the compiler for the caller and the callee; therefore,
  59    --  the run time never needs to decode this data.
  60    --  Mode can be either Asynchronous_Call (ATC) or Conditional_Call.
  61    --  Rendezvous_Successful is set to True on return if the call was serviced.
  62
  63    procedure Timed_Task_Entry_Call
  64      (Acceptor              : Task_Id;
  65       E                     : Task_Entry_Index;
  66       Uninterpreted_Data    : System.Address;
  67       Timeout               : Duration;
  68       Mode                  : Delay_Modes;
  69       Rendezvous_Successful : out Boolean);
  70    --  Timed entry call without using ATC.
  71    --  Compiler interface only. Do not call from within the RTS.
  72    --  See Task_Entry_Call for details on Acceptor, E and Uninterpreted_Data.
  73    --  Timeout is the value of the time out.
  74    --  Mode determines whether the delay is relative or absolute.
  75
  76    procedure Call_Simple
  77      (Acceptor           : Task_Id;
  78       E                  : Task_Entry_Index;
  79       Uninterpreted_Data : System.Address);
  80    --  Simple entry call.
  81    --  Compiler interface only. Do not call from within the RTS.
  82    --
  83    --  source:
  84    --     T.E1 (Params);
  85    --
  86    --  expansion:
  87    --    declare
  88    --       P : parms := (parm1, parm2, parm3);
  89    --       X : Task_Entry_Index := 1;
  90    --    begin
  91    --       Call_Simple (t._task_id, X, P'Address);
  92    --       parm1 := P.param1;
  93    --       parm2 := P.param2;
  94    --       ...
  95    --    end;
  96
  97    procedure Cancel_Task_Entry_Call (Cancelled : out Boolean);
  98    --  Cancel pending asynchronous task entry call.
  99    --  Compiler interface only. Do not call from within the RTS.
 100    --  See Exp_Ch9.Expand_N_Asynchronous_Select for code expansion.
 101
 102    procedure Requeue_Task_Entry
 103      (Acceptor   : Task_Id;
 104       E          : Task_Entry_Index;
 105       With_Abort : Boolean);
 106    --  Requeue from a task entry to a task entry.
 107    --  Compiler interface only. Do not call from within the RTS.
 108    --  The code generation for task entry requeues is different from that for
 109    --  protected entry requeues. There is a "goto" that skips around the call
 110    --  to Complete_Rendezvous, so that Requeue_Task_Entry must also do the work
 111    --  of Complete_Rendezvous. The difference is that it does not report that
 112    --  the call's State = Done.
 113    --
 114    --  source:
 115    --     accept e1 do
 116    --       ...A...
 117    --       requeue e2;
 118    --       ...B...
 119    --     end e1;
 120    --
 121    --  expansion:
 122    --     A62b : address;
 123    --     L61b : label
 124    --     begin
 125    --        accept_call (1, A62b);
 126    --        ...A...
 127    --        requeue_task_entry (tTV!(t)._task_id, 2, false);
 128    --        goto L61b;
 129    --        ...B...
 130    --        complete_rendezvous;
 131    --        <<L61b>>
 132    --     exception
 133    --        when others =>
 134    --           exceptional_complete_rendezvous (current_exception);
 135    --     end;
 136
 137    procedure Requeue_Protected_To_Task_Entry
 138      (Object     : STPE.Protection_Entries_Access;
 139       Acceptor   : Task_Id;
 140       E          : Task_Entry_Index;
 141       With_Abort : Boolean);
 142    --  Requeue from a protected entry to a task entry.
 143    --  Compiler interface only. Do not call from within the RTS.
 144    --
 145    --  source:
 146    --     entry e2 when b is
 147    --     begin
 148    --        b := false;
 149    --        ...A...
 150    --        requeue t.e2;
 151    --     end e2;
 152    --
 153    --  expansion:
 154    --     procedure rPT__E14b (O : address; P : address; E :
 155    --       protected_entry_index) is
 156    --        type rTVP is access rTV;
 157    --        freeze rTVP []
 158    --        _object : rTVP := rTVP!(O);
 159    --     begin
 160    --        declare
 161    --           rR : protection renames _object._object;
 162    --           vP : integer renames _object.v;
 163    --           bP : boolean renames _object.b;
 164    --        begin
 165    --           b := false;
 166    --           ...A...
 167    --           requeue_protected_to_task_entry (rR'unchecked_access, tTV!(t).
 168    --             _task_id, 2, false);
 169    --           return;
 170    --        end;
 171    --        complete_entry_body (_object._object'unchecked_access, objectF =>
 172    --          0);
 173    --        return;
 174    --     exception
 175    --        when others =>
 176    --           abort_undefer.all;
 177    --           exceptional_complete_entry_body (_object._object'
 178    --             unchecked_access, current_exception, objectF => 0);
 179    --           return;
 180    --     end rPT__E14b;
 181
 182    procedure Selective_Wait
 183      (Open_Accepts       : Accept_List_Access;
 184       Select_Mode        : Select_Modes;
 185       Uninterpreted_Data : out System.Address;
 186       Index              : out Select_Index);
 187    --  Implement select statement.
 188    --  Compiler interface only. Do not call from within the RTS.
 189    --  See comments on Accept_Call.
 190    --
 191    --  source:
 192    --     select accept e1 do
 193    --           ...A...
 194    --        end e1;
 195    --        ...B...
 196    --     or accept e2;
 197    --        ...C...
 198    --     end select;
 199    --
 200    --  expansion:
 201    --     A32b : address;
 202    --     declare
 203    --        A37b : T36b;
 204    --        A37b (1) := (null_body => false, s => 1);
 205    --        A37b (2) := (null_body => true, s => 2);
 206    --        S0 : aliased T36b := accept_list'A37b;
 207    --        J1 : select_index := 0;
 208    --        procedure e1A is
 209    --        begin
 210    --           abort_undefer.all;
 211    --           ...A...
 212    --           <<L31b>>
 213    --           complete_rendezvous;
 214    --        exception
 215    --           when all others =>
 216    --              exceptional_complete_rendezvous (get_gnat_exception);
 217    --        end e1A;
 218    --     begin
 219    --        selective_wait (S0'unchecked_access, simple_mode, A32b, J1);
 220    --        case J1 is
 221    --           when 0 =>
 222    --              goto L3;
 223    --           when 1 =>
 224    --              e1A;
 225    --              goto L1;
 226    --           when 2 =>
 227    --              goto L2;
 228    --           when others =>
 229    --              goto L3;
 230    --        end case;
 231    --        <<L1>>
 232    --        ...B...
 233    --        goto L3;
 234    --        <<L2>>
 235    --        ...C...
 236    --        goto L3;
 237    --        <<L3>>
 238    --     end;
 239
 240    procedure Timed_Selective_Wait
 241      (Open_Accepts       : Accept_List_Access;
 242       Select_Mode        : Select_Modes;
 243       Uninterpreted_Data : out System.Address;
 244       Timeout            : Duration;
 245       Mode               : Delay_Modes;
 246       Index              : out Select_Index);
 247    --  Selective wait with timeout without using ATC.
 248    --  Compiler interface only. Do not call from within the RTS.
 249
 250    procedure Accept_Call
 251      (E                  : Task_Entry_Index;
 252       Uninterpreted_Data : out System.Address);
 253    --  Accept an entry call.
 254    --  Compiler interface only. Do not call from within the RTS.
 255    --
 256    --  source:
 257    --              accept E do  ...A... end E;
 258    --  expansion:
 259    --              A27b : address;
 260    --              L26b : label
 261    --              begin
 262    --                 accept_call (1, A27b);
 263    --                 ...A...
 264    --                 complete_rendezvous;
 265    --              <<L26b>>
 266    --              exception
 267    --              when all others =>
 268    --                 exceptional_complete_rendezvous (get_gnat_exception);
 269    --              end;
 270    --
 271    --  The handler for Abort_Signal (*all* others) is to handle the case when
 272    --  the acceptor is aborted between Accept_Call and the corresponding
 273    --  Complete_Rendezvous call. We need to wake up the caller in this case.
 274    --
 275    --   See also Selective_Wait
 276
 277    procedure Accept_Trivial (E : Task_Entry_Index);
 278    --  Accept an entry call that has no parameters and no body.
 279    --  Compiler interface only. Do not call from within the RTS.
 280    --  This should only be called when there is no accept body, or the accept
 281    --  body is empty.
 282    --
 283    --  source:
 284    --               accept E;
 285    --  expansion:
 286    --               accept_trivial (1);
 287    --
 288    --  The compiler is also able to recognize the following and
 289    --  translate it the same way.
 290    --
 291    --     accept E do null; end E;
 292
 293    function Task_Count (E : Task_Entry_Index) return Natural;
 294    --  Return number of tasks waiting on the entry E (of current task)
 295    --  Compiler interface only. Do not call from within the RTS.
 296
 297    function Callable (T : Task_Id) return Boolean;
 298    --  Return T'Callable
 299    --  Compiler interface. Do not call from within the RTS, except for body of
 300    --  Ada.Task_Identification.
 301
 302    type Task_Entry_Nesting_Depth is new Task_Entry_Index
 303      range 0 .. Max_Task_Entry;
 304
 305    function Task_Entry_Caller (D : Task_Entry_Nesting_Depth) return Task_Id;
 306    --  Return E'Caller. This will only work if called from within an
 307    --  accept statement that is handling E, as required by the LRM (C.7.1(14)).
 308    --  Compiler interface only. Do not call from within the RTS.
 309
 310    procedure Complete_Rendezvous;
 311    --  Called by acceptor to wake up caller
 312
 313    procedure Exceptional_Complete_Rendezvous
 314      (Ex : Ada.Exceptions.Exception_Id);
 315    --  Called by acceptor to mark the end of the current rendezvous and
 316    --  propagate an exception to the caller.
 317
 318    --  For internal use only:
 319
 320    function Task_Do_Or_Queue
 321      (Self_ID    : Task_Id;
 322       Entry_Call : Entry_Call_Link;
 323       With_Abort : Boolean) return Boolean;
 324    --  Call this only with abort deferred and holding no locks, except
 325    --  the global RTS lock when Single_Lock is True which must be owned.
 326    --  Returns False iff the call cannot be served or queued, as is the
 327    --  case if the caller is not callable; i.e., a False return value
 328    --  indicates that Tasking_Error should be raised.
 329    --  Either initiate the entry call, such that the accepting task is
 330    --  free to execute the rendezvous, queue the call on the acceptor's
 331    --  queue, or cancel the call. Conditional calls that cannot be
 332    --  accepted immediately are cancelled.
 333
 334 end System.Tasking.Rendezvous;