1------------------------------------------------------------------------------ 2-- -- 3-- GNU ADA 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-2001, 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-- Note: the compiler generates direct calls to this interface, via Rtsfind. 35-- Any changes to this interface may require corresponding compiler changes. 36 37with Ada.Exceptions; 38-- Used for, Exception_Id 39 40with System.Tasking.Protected_Objects.Entries; 41-- used for Protection_Entries 42 43package 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 334end System.Tasking.Rendezvous; 335