File : s-tposen-xi-full.ads
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) 1998-2013, AdaCore --
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 -- --
19 -- --
20 -- --
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 -- No timed or conditional entry calls
43
44 -- Note that the difference with respect to the high integrity version of
45 -- this package is that exception handlers are allowed, so that support for
46 -- exceptional completion of entry bodies needs to be provided.
47
48 -- This interface is intended to be used in the Ravenscar profile, the
49 -- compiler is responsible for ensuring that the conditions mentioned above
50 -- are respected, except for the No_Entry_Queue restriction that is checked
51 -- dynamically in this package, since the check cannot be performed at compile
52 -- time, and is relatively cheap (see body).
53
54 -- This package is part of the high level tasking interface used by the
55 -- compiler to expand Ada 95 tasking constructs into simpler run time calls
56 -- (aka GNARLI, GNU Ada Run-time Library Interface)
57
58 -- Note: the compiler generates direct calls to this interface, via Rtsfind.
59 -- Any changes to this interface may require corresponding compiler changes
60 -- in exp_ch9.adb and possibly exp_ch7.adb
61
62 package System.Tasking.Protected_Objects.Single_Entry is
63 pragma Elaborate_Body;
64
65 ---------------------------------
66 -- Compiler Interface (GNARLI) --
67 ---------------------------------
68
69 -- The compiler will expand in the GNAT tree the following construct:
70
71 -- protected PO is
72 -- entry E;
73 -- procedure P;
74 -- private
75 -- Open : Boolean := False;
76 -- end PO;
77
78 -- protected body PO is
79 -- entry E when Open is
80 -- ...variable declarations...
81 -- begin
82 -- ...B...
83 -- end E;
84
85 -- procedure P is
86 -- ...variable declarations...
87 -- begin
88 -- ...C...
89 -- end P;
90 -- end PO;
91
92 -- as follows:
93
94 -- protected type poT is
95 -- entry e;
96 -- procedure p;
97 -- private
98 -- open : boolean := false;
99 -- end poT;
100 -- type poTV is limited record
101 -- open : boolean := false;
102 -- _object : aliased protection_entry;
103 -- end record;
104 -- procedure poPT__E1s (O : address; P : address; E :
105 -- protected_entry_index);
106 -- function poPT__B2s (O : address; E : protected_entry_index) return
107 -- boolean;
108 -- procedure poPT__pN (_object : in out poTV);
109 -- procedure poPT__pP (_object : in out poTV);
110 -- poTA : aliased entry_body := (
111 -- barrier => poPT__B2s'unrestricted_access,
112 -- action => poPT__E1s'unrestricted_access);
113 -- freeze poTV [
114 -- procedure poTVIP (_init : in out poTV) is
115 -- begin
116 -- _init.open := false;
117 -- object-init-proc (_init._object);
118 -- initialize_protection_entry (_init._object'unchecked_access,
119 -- unspecified_priority, _init'address, poTA'
120 -- unrestricted_access);
121 -- return;
122 -- end poTVIP;
123 -- ]
124 -- po : poT;
125 -- poTVIP (poTV!(po));
126
127 -- function poPT__B2s (O : address; E : protected_entry_index) return
128 -- boolean is
129 -- type poTVP is access poTV;
130 -- _object : poTVP := poTVP!(O);
131 -- poR : protection_entry renames _object._object;
132 -- openP : boolean renames _object.open;
133 -- begin
134 -- return open;
135 -- end poPT__B2s;
136
137 -- procedure poPT__E1s (O : address; P : address; E :
138 -- protected_entry_index) is
139 -- type poTVP is access poTV;
140 -- _object : poTVP := poTVP!(O);
141 -- begin
142 -- B1b : declare
143 -- poR : protection_entry renames _object._object;
144 -- openP : boolean renames _object.open;
145 -- ...variable declarations...
146 -- begin
147 -- ...B...
148 -- end B1b;
149 -- return;
150 -- end poPT__E1s;
151
152 -- procedure poPT__pN (_object : in out poTV) is
153 -- poR : protection_entry renames _object._object;
154 -- openP : boolean renames _object.open;
155 -- ...variable declarations...
156 -- begin
157 -- ...C...
158 -- return;
159 -- end poPT__pN;
160
161 -- procedure poPT__pP (_object : in out poTV) is
162 -- procedure _clean is
163 -- begin
164 -- service_entry (_object._object'unchecked_access);
165 -- return;
166 -- end _clean;
167 -- begin
168 -- lock_entry (_object._object'unchecked_access);
169 -- B5b : begin
170 -- poPT__pN (_object);
171 -- at end
172 -- _clean;
173 -- end B5b;
174 -- return;
175 -- end poPT__pP;
176
177 type Protection_Entry is limited private;
178 -- This type contains the GNARL state of a protected object. The
179 -- application-defined portion of the state (i.e. private objects)
180 -- is maintained by the compiler-generated code.
181
182 type Protection_Entry_Access is access all Protection_Entry;
183
184 procedure Initialize_Protection_Entry
185 (Object : Protection_Entry_Access;
186 Ceiling_Priority : Integer;
187 Compiler_Info : System.Address;
188 Entry_Body : Entry_Body_Access);
189 -- Initialize the Object parameter so that it can be used by the run time
190 -- to keep track of the runtime state of a protected object.
191
192 procedure Lock_Entry (Object : Protection_Entry_Access);
193 -- Lock a protected object for write access. Upon return, the caller
194 -- owns the lock to this object, and no other call to Lock with the same
195 -- argument will return until the corresponding call to Unlock has been
196 -- made by the caller.
197
198 procedure Unlock_Entry (Object : Protection_Entry_Access);
199 -- Relinquish ownership of the lock for the object represented by
200 -- the Object parameter. One of the tasks waiting on this lock (if any)
201 -- will be given the lock and allowed to return from the Lock call.
202
203 procedure Service_Entry (Object : Protection_Entry_Access);
204 -- Service the entry queue of the specified object, executing the
205 -- corresponding body of any queued entry call that is waiting on True
206 -- barrier. This is used when the state of a protected object may have
207 -- changed, in particular after the execution of the statement sequence
208 -- of a protected procedure. This procedure must be called with abort
209 -- deferred and with the corresponding object locked. Object is unlocked
210 -- on return.
211
212 procedure Protected_Single_Entry_Call
213 (Object : Protection_Entry_Access;
214 Uninterpreted_Data : System.Address);
215 -- Make a protected entry call to the specified object. Pends a protected
216 -- entry call on the protected object represented by Object. A pended call
217 -- is not queued; it may be executed immediately or queued, depending on
218 -- the state of the entry barrier.
219 --
220 -- Uninterpreted_Data
221 -- This will be returned by Next_Entry_Call when this call is serviced.
222 -- It can be used by the compiler to pass information between the
223 -- caller and the server, in particular entry parameters.
224
225 procedure Exceptional_Complete_Single_Entry_Body
226 (Object : Protection_Entry_Access;
227 Ex : Ada.Exceptions.Exception_Id);
228 -- Perform all of the functions of Complete_Entry_Body. In addition, report
229 -- in Ex the exception whose propagation terminated the entry body to the
230 -- runtime system.
231
232 function Protected_Count_Entry (Object : Protection_Entry) return Natural;
233 -- Return the number of entry calls on Object (0 or 1)
234
235 function Protected_Single_Entry_Caller
236 (Object : Protection_Entry) return Task_Id;
237 -- Return value of E'Caller, where E is the protected entry currently
238 -- being handled. This will only work if called from within an
239 -- entry body, as required by the LRM (C.7.1(14)).
240
241 private
242 type Protection_Entry is record
243 Common : aliased Protection;
244 -- State of the protected object. This part is common to any protected
245 -- object, including those without entries.
246
247 Compiler_Info : System.Address;
248 -- Pointer to compiler-generated record representing protected object
249
250 Call_In_Progress : Entry_Call_Link;
251 -- Pointer to the entry call being executed (if any)
252
253 Entry_Body : Entry_Body_Access;
254 -- Pointer to the executable code for entry body of the protected type
255
256 Entry_Queue : Entry_Call_Link;
257 -- Place to store the waiting entry call (if any)
258 end record;
259 pragma Suppress_Initialization (Protection_Entry);
260
261 end System.Tasking.Protected_Objects.Single_Entry;