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