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