1 ------------------------------------------------------------------------------
3 -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S . --
6 -- O P E R A T I O N S --
10 -- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
12 -- GNARL is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNARL; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNARL was developed by the GNARL team at Florida State University. --
31 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
33 ------------------------------------------------------------------------------
35 -- This package contains all the extended primitives related to
36 -- Protected_Objects with entries.
37 -- The handling of protected objects with no entries is done in
38 -- System.Tasking.Protected_Objects, the simple routines for protected
39 -- objects with entries in System.Tasking.Protected_Objects.Entries.
40 -- The split between Entries and Operations is needed to break circular
41 -- dependencies inside the run time.
43 -- Note: the compiler generates direct calls to this interface, via Rtsfind.
44 -- Any changes to this interface may require corresponding compiler changes.
47 -- used for Exception_Id
49 with System
.Tasking
.Protected_Objects
.Entries
;
51 package System
.Tasking
.Protected_Objects
.Operations
is
52 pragma Elaborate_Body
;
54 type Communication_Block
is private;
55 -- Objects of this type are passed between GNARL calls to allow RTS
56 -- information to be preserved.
58 procedure Protected_Entry_Call
59 (Object
: Entries
.Protection_Entries_Access
;
60 E
: Protected_Entry_Index
;
61 Uninterpreted_Data
: System
.Address
;
63 Block
: out Communication_Block
);
64 -- Make a protected entry call to the specified object.
65 -- Pend a protected entry call on the protected object represented
66 -- by Object. A pended call is not queued; it may be executed immediately
67 -- or queued, depending on the state of the entry barrier.
70 -- The index representing the entry to be called.
73 -- This will be returned by Next_Entry_Call when this call is serviced.
74 -- It can be used by the compiler to pass information between the
75 -- caller and the server, in particular entry parameters.
78 -- The kind of call to be pended
81 -- Information passed between runtime calls by the compiler
83 procedure Timed_Protected_Entry_Call
84 (Object
: Entries
.Protection_Entries_Access
;
85 E
: Protected_Entry_Index
;
86 Uninterpreted_Data
: System
.Address
;
89 Entry_Call_Successful
: out Boolean);
90 -- Same as the Protected_Entry_Call but with time-out specified.
91 -- This routines is used when we do not use ATC mechanism to implement
94 procedure Service_Entries
(Object
: Entries
.Protection_Entries_Access
);
95 pragma Inline
(Service_Entries
);
97 procedure PO_Service_Entries
99 Object
: Entries
.Protection_Entries_Access
;
100 Unlock_Object
: Boolean := True);
101 -- Service all entry queues of the specified object, executing the
102 -- corresponding bodies of any queued entry calls that are waiting
103 -- on True barriers. This is used when the state of a protected
104 -- object may have changed, in particular after the execution of
105 -- the statement sequence of a protected procedure.
107 -- Note that servicing an entry may change the value of one or more
108 -- barriers, so this routine keeps checking barriers until all of
111 -- This must be called with abortion deferred and with the corresponding
114 -- If Unlock_Object is set True, then Object is unlocked on return,
115 -- otherwise Object remains locked and the caller is responsible for
116 -- the required unlock.
118 procedure Complete_Entry_Body
(Object
: Entries
.Protection_Entries_Access
);
119 -- Called from within an entry body procedure, indicates that the
120 -- corresponding entry call has been serviced.
122 procedure Exceptional_Complete_Entry_Body
123 (Object
: Entries
.Protection_Entries_Access
;
124 Ex
: Ada
.Exceptions
.Exception_Id
);
125 -- Perform all of the functions of Complete_Entry_Body. In addition,
126 -- report in Ex the exception whose propagation terminated the entry
127 -- body to the runtime system.
129 procedure Cancel_Protected_Entry_Call
(Block
: in out Communication_Block
);
130 -- Attempt to cancel the most recent protected entry call. If the call is
131 -- not queued abortably, wait until it is or until it has completed.
132 -- If the call is actually cancelled, the called object will be
133 -- locked on return from this call. Get_Cancelled (Block) can be
134 -- used to determine if the cancellation took place; there
135 -- may be entries needing service in this case.
137 -- Block passes information between this and other runtime calls.
139 function Enqueued
(Block
: Communication_Block
) return Boolean;
140 -- Returns True if the Protected_Entry_Call which returned the
141 -- specified Block object was queued; False otherwise.
143 function Cancelled
(Block
: Communication_Block
) return Boolean;
144 -- Returns True if the Protected_Entry_Call which returned the
145 -- specified Block object was cancelled, False otherwise.
147 procedure Requeue_Protected_Entry
148 (Object
: Entries
.Protection_Entries_Access
;
149 New_Object
: Entries
.Protection_Entries_Access
;
150 E
: Protected_Entry_Index
;
151 With_Abort
: Boolean);
152 -- If Object = New_Object, queue the protected entry call on Object
153 -- currently being serviced on the queue corresponding to the entry
156 -- If Object /= New_Object, transfer the call to New_Object.E,
157 -- executing or queuing it as appropriate.
159 -- With_Abort---True if the call is to be queued abortably, false
162 procedure Requeue_Task_To_Protected_Entry
163 (New_Object
: Entries
.Protection_Entries_Access
;
164 E
: Protected_Entry_Index
;
165 With_Abort
: Boolean);
166 -- Transfer task entry call currently being serviced to entry E
169 -- With_Abort---True if the call is to be queued abortably, false
172 function Protected_Count
173 (Object
: Entries
.Protection_Entries
'Class;
174 E
: Protected_Entry_Index
)
176 -- Return the number of entry calls to E on Object.
178 function Protected_Entry_Caller
179 (Object
: Entries
.Protection_Entries
'Class) return Task_Id
;
180 -- Return value of E'Caller, where E is the protected entry currently
181 -- being handled. This will only work if called from within an entry
182 -- body, as required by the LRM (C.7.1(14)).
184 -- For internal use only:
186 procedure PO_Do_Or_Queue
188 Object
: Entries
.Protection_Entries_Access
;
189 Entry_Call
: Entry_Call_Link
;
190 With_Abort
: Boolean);
191 -- This procedure either executes or queues an entry call, depending
192 -- on the status of the corresponding barrier. It assumes that abortion
193 -- is deferred and that the specified object is locked.
196 type Communication_Block
is record
198 Enqueued
: Boolean := True;
199 Cancelled
: Boolean := False;
201 pragma Volatile
(Communication_Block
);
204 -- The Communication_Block seems to be a relic.
205 -- At the moment, the compiler seems to be generating
206 -- unnecessary conditional code based on this block.
207 -- See the code generated for async. select with task entry
208 -- call for another way of solving this.
210 end System
.Tasking
.Protected_Objects
.Operations
;