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-2019, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT 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 type Entry_Body_Access is access constant Entry_Body; 186 -- Access to barrier and action function of an 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 owns 198 -- the lock to this object, and no other call to Lock or Lock_Read_Only 199 -- with the same argument will return until the corresponding call to 200 -- 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 owns 205 -- the lock for read access, and no other calls to Lock with the same 206 -- argument will return until the corresponding call to Unlock has been 207 -- made by the caller. Other calls to Lock_Read_Only may (but need not) 208 -- return before the call to Unlock, and the corresponding callers will 209 -- 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 the 213 -- Object parameter. If this ownership was for write access, or if it was 214 -- for read access where there are no other read access locks outstanding, 215 -- one (or more, in the case of Lock_Read_Only) of the tasks waiting on 216 -- this lock (if any) will be given the lock and allowed to return from 217 -- 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 224 -- of a protected procedure. 225 -- 226 -- This must be called with abort deferred and with the corresponding 227 -- object locked. Object is unlocked on return. 228 229 procedure Protected_Single_Entry_Call 230 (Object : Protection_Entry_Access; 231 Uninterpreted_Data : System.Address); 232 -- Make a protected entry call to the specified object 233 -- 234 -- Pends a protected entry call on the protected object represented by 235 -- Object. A pended call is not queued; it may be executed immediately 236 -- or queued, depending on the state of the entry barrier. 237 -- 238 -- Uninterpreted_Data 239 -- This will be returned by Next_Entry_Call when this call is serviced. 240 -- It can be used by the compiler to pass information between the 241 -- caller and the server, in particular entry parameters. 242 243 procedure Exceptional_Complete_Single_Entry_Body 244 (Object : Protection_Entry_Access; 245 Ex : Ada.Exceptions.Exception_Id); 246 -- Perform all of the functions of Complete_Entry_Body. In addition, report 247 -- in Ex the exception whose propagation terminated the entry body to the 248 -- runtime system. 249 250 function Protected_Count_Entry (Object : Protection_Entry) return Natural; 251 -- Return the number of entry calls on Object (0 or 1) 252 253 function Protected_Single_Entry_Caller 254 (Object : Protection_Entry) return Task_Id; 255 -- Return value of E'Caller, where E is the protected entry currently being 256 -- handled. This will only work if called from within an entry body, as 257 -- required by the LRM (C.7.1(14)). 258 259private 260 type Protection_Entry is record 261 Common : aliased Protection; 262 -- State of the protected object. This part is common to any protected 263 -- object, including those without entries. 264 265 Compiler_Info : System.Address; 266 -- Pointer to compiler-generated record representing protected object 267 268 Call_In_Progress : Entry_Call_Link; 269 -- Pointer to the entry call being executed (if any) 270 271 Entry_Body : Entry_Body_Access; 272 -- Pointer to executable code for the entry body of the protected type 273 274 Entry_Queue : Entry_Call_Link; 275 -- Place to store the waiting entry call (if any) 276 end record; 277 278end System.Tasking.Protected_Objects.Single_Entry; 279