1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- 4-- -- 5-- SYSTEM.TASKING.PROTECTED_OBJECTS.SINGLE_ENTRY -- 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-- This package provides an optimized version of Protected_Objects.Operations 33-- and Protected_Objects.Entries making the following assumptions: 34-- 35-- PO have only one entry 36-- There is only one caller at a time (No_Entry_Queue) 37-- There is no dynamic priority support (No_Dynamic_Priorities) 38-- No Abort Statements 39-- (No_Abort_Statements, Max_Asynchronous_Select_Nesting => 0) 40-- PO are at library level 41-- None of the tasks will terminate (no need for finalization) 42-- 43-- This interface is intended to be used in the ravenscar profile, the 44-- compiler is responsible for ensuring that the conditions mentioned above 45-- are respected, except for the No_Entry_Queue restriction that is checked 46-- dynamically in this package, since the check cannot be performed at compile 47-- time, and is relatively cheap (see body). 48-- 49-- This package is part of the high level tasking interface used by the 50-- compiler to expand Ada 95 tasking constructs into simpler run time calls 51-- (aka GNARLI, GNU Ada Run-time Library Interface) 52-- 53-- Note: the compiler generates direct calls to this interface, via Rtsfind. 54-- Any changes to this interface may require corresponding compiler changes 55-- in exp_ch9.adb and possibly exp_ch7.adb 56 57package System.Tasking.Protected_Objects.Single_Entry is 58 pragma Elaborate_Body; 59 60 --------------------------------- 61 -- Compiler Interface (GNARLI) -- 62 --------------------------------- 63 64 -- The compiler will expand in the GNAT tree the following construct: 65 66 -- protected PO is 67 -- entry E; 68 -- procedure P; 69 -- private 70 -- Open : Boolean := False; 71 -- end PO; 72 73 -- protected body PO is 74 -- entry E when Open is 75 -- ...variable declarations... 76 -- begin 77 -- ...B... 78 -- end E; 79 80 -- procedure P is 81 -- ...variable declarations... 82 -- begin 83 -- ...C... 84 -- end P; 85 -- end PO; 86 87 -- as follows: 88 89 -- protected type poT is 90 -- entry e; 91 -- procedure p; 92 -- private 93 -- open : boolean := false; 94 -- end poT; 95 -- type poTV is limited record 96 -- open : boolean := false; 97 -- _object : aliased protection_entry; 98 -- end record; 99 -- procedure poPT__E1s (O : address; P : address; E : 100 -- protected_entry_index); 101 -- function poPT__B2s (O : address; E : protected_entry_index) return 102 -- boolean; 103 -- procedure poPT__pN (_object : in out poTV); 104 -- procedure poPT__pP (_object : in out poTV); 105 -- poTA : aliased entry_body := ( 106 -- barrier => poPT__B2s'unrestricted_access, 107 -- action => poPT__E1s'unrestricted_access); 108 -- freeze poTV [ 109 -- procedure poTVIP (_init : in out poTV) is 110 -- begin 111 -- _init.open := false; 112 -- object-init-proc (_init._object); 113 -- initialize_protection_entry (_init._object'unchecked_access, 114 -- unspecified_priority, _init'address, poTA' 115 -- unrestricted_access); 116 -- return; 117 -- end poTVIP; 118 -- ] 119 -- po : poT; 120 -- poTVIP (poTV!(po)); 121 122 -- function poPT__B2s (O : address; E : protected_entry_index) return 123 -- boolean is 124 -- type poTVP is access poTV; 125 -- _object : poTVP := poTVP!(O); 126 -- poR : protection_entry renames _object._object; 127 -- openP : boolean renames _object.open; 128 -- begin 129 -- return open; 130 -- end poPT__B2s; 131 132 -- procedure poPT__E1s (O : address; P : address; E : 133 -- protected_entry_index) is 134 -- type poTVP is access poTV; 135 -- _object : poTVP := poTVP!(O); 136 -- begin 137 -- B1b : declare 138 -- poR : protection_entry renames _object._object; 139 -- openP : boolean renames _object.open; 140 -- ...variable declarations... 141 -- begin 142 -- ...B... 143 -- end B1b; 144 -- complete_single_entry_body (_object._object'unchecked_access); 145 -- return; 146 -- exception 147 -- when all others => 148 -- exceptional_complete_single_entry_body (_object._object' 149 -- unchecked_access, get_gnat_exception); 150 -- return; 151 -- end poPT__E1s; 152 153 -- procedure poPT__pN (_object : in out poTV) is 154 -- poR : protection_entry renames _object._object; 155 -- openP : boolean renames _object.open; 156 -- ...variable declarations... 157 -- begin 158 -- ...C... 159 -- return; 160 -- end poPT__pN; 161 162 -- procedure poPT__pP (_object : in out poTV) is 163 -- procedure _clean is 164 -- begin 165 -- service_entry (_object._object'unchecked_access); 166 -- return; 167 -- end _clean; 168 -- begin 169 -- lock_entry (_object._object'unchecked_access); 170 -- B5b : begin 171 -- poPT__pN (_object); 172 -- at end 173 -- _clean; 174 -- end B5b; 175 -- return; 176 -- end poPT__pP; 177 178 type Protection_Entry is limited private; 179 -- This type contains the GNARL state of a protected object. The 180 -- application-defined portion of the state (i.e. private objects) 181 -- is maintained by the compiler-generated code. 182 183 type Protection_Entry_Access is access all Protection_Entry; 184 185 procedure Initialize_Protection_Entry 186 (Object : Protection_Entry_Access; 187 Ceiling_Priority : Integer; 188 Compiler_Info : System.Address; 189 Entry_Body : Entry_Body_Access); 190 -- Initialize the Object parameter so that it can be used by the run time 191 -- to keep track of the runtime state of a protected object. 192 193 procedure Lock_Entry (Object : Protection_Entry_Access); 194 -- Lock a protected object for write access. Upon return, the caller 195 -- owns the lock to this object, and no other call to Lock or 196 -- Lock_Read_Only with the same argument will return until the 197 -- corresponding call to Unlock has been made by the caller. 198 199 procedure Lock_Read_Only_Entry 200 (Object : Protection_Entry_Access); 201 -- Lock a protected object for read access. Upon return, the caller 202 -- owns the lock for read access, and no other calls to Lock 203 -- with the same argument will return until the corresponding call 204 -- to Unlock has been made by the caller. Other calls to Lock_Read_Only 205 -- may (but need not) return before the call to Unlock, and the 206 -- corresponding callers will also own the lock for read access. 207 208 procedure Unlock_Entry (Object : Protection_Entry_Access); 209 -- Relinquish ownership of the lock for the object represented by 210 -- the Object parameter. If this ownership was for write access, or 211 -- if it was for read access where there are no other read access 212 -- locks outstanding, one (or more, in the case of Lock_Read_Only) 213 -- of the tasks waiting on this lock (if any) will be given the 214 -- lock and allowed to return from the Lock or Lock_Read_Only call. 215 216 procedure Service_Entry (Object : Protection_Entry_Access); 217 -- Service the entry queue of the specified object, executing the 218 -- corresponding body of any queued entry call that is waiting on True 219 -- barrier. This is used when the state of a protected object may have 220 -- changed, in particular after the execution of the statement sequence of 221 -- a protected procedure. 222 -- 223 -- This must be called with abort deferred and with the corresponding 224 -- object locked. Object is unlocked on return. 225 226 procedure Protected_Single_Entry_Call 227 (Object : Protection_Entry_Access; 228 Uninterpreted_Data : System.Address; 229 Mode : Call_Modes); 230 -- Make a protected entry call to the specified object. 231 -- Pend a protected entry call on the protected object represented 232 -- by Object. A pended call is not queued; it may be executed immediately 233 -- or queued, depending on the state of the entry barrier. 234 -- 235 -- Uninterpreted_Data 236 -- This will be returned by Next_Entry_Call when this call is serviced. 237 -- It can be used by the compiler to pass information between the 238 -- caller and the server, in particular entry parameters. 239 -- 240 -- Mode 241 -- The kind of call to be pended 242 243 procedure Timed_Protected_Single_Entry_Call 244 (Object : Protection_Entry_Access; 245 Uninterpreted_Data : System.Address; 246 Timeout : Duration; 247 Mode : Delay_Modes; 248 Entry_Call_Successful : out Boolean); 249 -- Same as the Protected_Entry_Call but with time-out specified. 250 -- This routine is used to implement timed entry calls. 251 252 procedure Complete_Single_Entry_Body 253 (Object : Protection_Entry_Access); 254 pragma Inline (Complete_Single_Entry_Body); 255 -- Called from within an entry body procedure, indicates that the 256 -- corresponding entry call has been serviced. 257 258 procedure Exceptional_Complete_Single_Entry_Body 259 (Object : Protection_Entry_Access; 260 Ex : Ada.Exceptions.Exception_Id); 261 -- Perform all of the functions of Complete_Entry_Body. In addition, 262 -- report in Ex the exception whose propagation terminated the entry 263 -- body to the runtime system. 264 265 function Protected_Count_Entry (Object : Protection_Entry) 266 return Natural; 267 -- Return the number of entry calls on Object (0 or 1) 268 269 function Protected_Single_Entry_Caller (Object : Protection_Entry) 270 return Task_Id; 271 -- Return value of E'Caller, where E is the protected entry currently 272 -- being handled. This will only work if called from within an 273 -- entry body, as required by the LRM (C.7.1(14)). 274 275private 276 type Protection_Entry is record 277 Common : aliased Protection; 278 -- State of the protected object. This part is common to any protected 279 -- object, including those without entries. 280 281 Compiler_Info : System.Address; 282 -- Pointer to compiler-generated record representing protected object 283 284 Call_In_Progress : Entry_Call_Link; 285 -- Pointer to the entry call being executed (if any) 286 287 Entry_Body : Entry_Body_Access; 288 -- Pointer to executable code for the entry body of the protected type 289 290 Entry_Queue : Entry_Call_Link; 291 -- Place to store the waiting entry call (if any) 292 end record; 293 294end System.Tasking.Protected_Objects.Single_Entry; 295