1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M . T A S K I N G . R E N D E Z V O U S --
9 -- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
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. --
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. --
29 -- GNARL was developed by the GNARL team at Florida State University. --
30 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
32 ------------------------------------------------------------------------------
34 -- Note: the compiler generates direct calls to this interface, via Rtsfind.
35 -- Any changes to this interface may require corresponding compiler changes.
39 with System
.Tasking
.Protected_Objects
.Entries
;
41 package System
.Tasking
.Rendezvous
is
43 package STPE
renames System
.Tasking
.Protected_Objects
.Entries
;
45 procedure Task_Entry_Call
48 Uninterpreted_Data
: System
.Address
;
50 Rendezvous_Successful
: out Boolean);
51 -- General entry call used to implement ATC or conditional entry calls.
52 -- Compiler interface only. Do not call from within the RTS.
53 -- Acceptor is the ID of the acceptor task.
54 -- E is the entry index requested.
55 -- Uninterpreted_Data represents the parameters of the entry. It is
56 -- constructed by the compiler for the caller and the callee; therefore,
57 -- the run time never needs to decode this data.
58 -- Mode can be either Asynchronous_Call (ATC) or Conditional_Call.
59 -- Rendezvous_Successful is set to True on return if the call was serviced.
61 procedure Timed_Task_Entry_Call
64 Uninterpreted_Data
: System
.Address
;
67 Rendezvous_Successful
: out Boolean);
68 -- Timed entry call without using ATC.
69 -- Compiler interface only. Do not call from within the RTS.
70 -- See Task_Entry_Call for details on Acceptor, E and Uninterpreted_Data.
71 -- Timeout is the value of the time out.
72 -- Mode determines whether the delay is relative or absolute.
77 Uninterpreted_Data
: System
.Address
);
79 -- Compiler interface only. Do not call from within the RTS.
86 -- P : parms := (parm1, parm2, parm3);
87 -- X : Task_Entry_Index := 1;
89 -- Call_Simple (t._task_id, X, P'Address);
95 procedure Cancel_Task_Entry_Call
(Cancelled
: out Boolean);
96 -- Cancel pending asynchronous task entry call.
97 -- Compiler interface only. Do not call from within the RTS.
98 -- See Exp_Ch9.Expand_N_Asynchronous_Select for code expansion.
100 procedure Requeue_Task_Entry
102 E
: Task_Entry_Index
;
103 With_Abort
: Boolean);
104 -- Requeue from a task entry to a task entry.
105 -- Compiler interface only. Do not call from within the RTS.
106 -- The code generation for task entry requeues is different from that for
107 -- protected entry requeues. There is a "goto" that skips around the call
108 -- to Complete_Rendezvous, so that Requeue_Task_Entry must also do the work
109 -- of Complete_Rendezvous. The difference is that it does not report that
110 -- the call's State = Done.
123 -- accept_call (1, A62b);
125 -- requeue_task_entry (tTV!(t)._task_id, 2, false);
128 -- complete_rendezvous;
132 -- exceptional_complete_rendezvous (current_exception);
135 procedure Requeue_Protected_To_Task_Entry
136 (Object
: STPE
.Protection_Entries_Access
;
138 E
: Task_Entry_Index
;
139 With_Abort
: Boolean);
140 -- Requeue from a protected entry to a task entry.
141 -- Compiler interface only. Do not call from within the RTS.
144 -- entry e2 when b is
152 -- procedure rPT__E14b (O : address; P : address; E :
153 -- protected_entry_index) is
154 -- type rTVP is access rTV;
156 -- _object : rTVP := rTVP!(O);
159 -- rR : protection renames _object._object;
160 -- vP : integer renames _object.v;
161 -- bP : boolean renames _object.b;
165 -- requeue_protected_to_task_entry (rR'unchecked_access, tTV!(t).
166 -- _task_id, 2, false);
169 -- complete_entry_body (_object._object'unchecked_access, objectF =>
174 -- abort_undefer.all;
175 -- exceptional_complete_entry_body (_object._object'
176 -- unchecked_access, current_exception, objectF => 0);
180 procedure Selective_Wait
181 (Open_Accepts
: Accept_List_Access
;
182 Select_Mode
: Select_Modes
;
183 Uninterpreted_Data
: out System
.Address
;
184 Index
: out Select_Index
);
185 -- Implement select statement.
186 -- Compiler interface only. Do not call from within the RTS.
187 -- See comments on Accept_Call.
190 -- select accept e1 do
202 -- A37b (1) := (null_body => false, s => 1);
203 -- A37b (2) := (null_body => true, s => 2);
204 -- S0 : aliased T36b := accept_list'A37b;
205 -- J1 : select_index := 0;
208 -- abort_undefer.all;
211 -- complete_rendezvous;
213 -- when all others =>
214 -- exceptional_complete_rendezvous (get_gnat_exception);
217 -- selective_wait (S0'unchecked_access, simple_mode, A32b, J1);
238 procedure Timed_Selective_Wait
239 (Open_Accepts
: Accept_List_Access
;
240 Select_Mode
: Select_Modes
;
241 Uninterpreted_Data
: out System
.Address
;
244 Index
: out Select_Index
);
245 -- Selective wait with timeout without using ATC.
246 -- Compiler interface only. Do not call from within the RTS.
248 procedure Accept_Call
249 (E
: Task_Entry_Index
;
250 Uninterpreted_Data
: out System
.Address
);
251 -- Accept an entry call.
252 -- Compiler interface only. Do not call from within the RTS.
255 -- accept E do ...A... end E;
260 -- accept_call (1, A27b);
262 -- complete_rendezvous;
265 -- when all others =>
266 -- exceptional_complete_rendezvous (get_gnat_exception);
269 -- The handler for Abort_Signal (*all* others) is to handle the case when
270 -- the acceptor is aborted between Accept_Call and the corresponding
271 -- Complete_Rendezvous call. We need to wake up the caller in this case.
273 -- See also Selective_Wait
275 procedure Accept_Trivial
(E
: Task_Entry_Index
);
276 -- Accept an entry call that has no parameters and no body.
277 -- Compiler interface only. Do not call from within the RTS.
278 -- This should only be called when there is no accept body, or the accept
284 -- accept_trivial (1);
286 -- The compiler is also able to recognize the following and
287 -- translate it the same way.
289 -- accept E do null; end E;
291 function Task_Count
(E
: Task_Entry_Index
) return Natural;
292 -- Return number of tasks waiting on the entry E (of current task)
293 -- Compiler interface only. Do not call from within the RTS.
295 function Callable
(T
: Task_Id
) return Boolean;
297 -- Compiler interface. Do not call from within the RTS, except for body of
298 -- Ada.Task_Identification.
300 type Task_Entry_Nesting_Depth
is new Task_Entry_Index
301 range 0 .. Max_Task_Entry
;
303 function Task_Entry_Caller
(D
: Task_Entry_Nesting_Depth
) return Task_Id
;
304 -- Return E'Caller. This will only work if called from within an
305 -- accept statement that is handling E, as required by the LRM (C.7.1(14)).
306 -- Compiler interface only. Do not call from within the RTS.
308 procedure Complete_Rendezvous
;
309 -- Called by acceptor to wake up caller
311 procedure Exceptional_Complete_Rendezvous
312 (Ex
: Ada
.Exceptions
.Exception_Id
);
313 -- Called by acceptor to mark the end of the current rendezvous and
314 -- propagate an exception to the caller.
316 -- For internal use only:
318 function Task_Do_Or_Queue
320 Entry_Call
: Entry_Call_Link
) return Boolean;
321 -- Call this only with abort deferred and holding no locks, except
322 -- the global RTS lock when Single_Lock is True which must be owned.
323 -- Returns False iff the call cannot be served or queued, as is the
324 -- case if the caller is not callable; i.e., a False return value
325 -- indicates that Tasking_Error should be raised.
326 -- Either initiate the entry call, such that the accepting task is
327 -- free to execute the rendezvous, queue the call on the acceptor's
328 -- queue, or cancel the call. Conditional calls that cannot be
329 -- accepted immediately are cancelled.
331 end System
.Tasking
.Rendezvous
;