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-2001, 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 -- Service all entry queues of the specified object, executing the
101 -- corresponding bodies of any queued entry calls that are waiting
102 -- on True barriers. This is used when the state of a protected
103 -- object may have changed, in particular after the execution of
104 -- the statement sequence of a protected procedure.
105 -- Note that servicing an entry may change the value of one or more
106 -- barriers, so this routine keeps checking barriers until all of
109 -- This must be called with abortion deferred and with the corresponding
112 procedure Complete_Entry_Body
(Object
: Entries
.Protection_Entries_Access
);
113 -- Called from within an entry body procedure, indicates that the
114 -- corresponding entry call has been serviced.
116 procedure Exceptional_Complete_Entry_Body
117 (Object
: Entries
.Protection_Entries_Access
;
118 Ex
: Ada
.Exceptions
.Exception_Id
);
119 -- Perform all of the functions of Complete_Entry_Body. In addition,
120 -- report in Ex the exception whose propagation terminated the entry
121 -- body to the runtime system.
123 procedure Cancel_Protected_Entry_Call
(Block
: in out Communication_Block
);
124 -- Attempt to cancel the most recent protected entry call. If the call is
125 -- not queued abortably, wait until it is or until it has completed.
126 -- If the call is actually cancelled, the called object will be
127 -- locked on return from this call. Get_Cancelled (Block) can be
128 -- used to determine if the cancellation took place; there
129 -- may be entries needing service in this case.
131 -- Block passes information between this and other runtime calls.
133 function Enqueued
(Block
: Communication_Block
) return Boolean;
134 -- Returns True if the Protected_Entry_Call which returned the
135 -- specified Block object was queued; False otherwise.
137 function Cancelled
(Block
: Communication_Block
) return Boolean;
138 -- Returns True if the Protected_Entry_Call which returned the
139 -- specified Block object was cancelled, False otherwise.
141 procedure Requeue_Protected_Entry
142 (Object
: Entries
.Protection_Entries_Access
;
143 New_Object
: Entries
.Protection_Entries_Access
;
144 E
: Protected_Entry_Index
;
145 With_Abort
: Boolean);
146 -- If Object = New_Object, queue the protected entry call on Object
147 -- currently being serviced on the queue corresponding to the entry
150 -- If Object /= New_Object, transfer the call to New_Object.E,
151 -- executing or queuing it as appropriate.
153 -- With_Abort---True if the call is to be queued abortably, false
156 procedure Requeue_Task_To_Protected_Entry
157 (New_Object
: Entries
.Protection_Entries_Access
;
158 E
: Protected_Entry_Index
;
159 With_Abort
: Boolean);
160 -- Transfer task entry call currently being serviced to entry E
163 -- With_Abort---True if the call is to be queued abortably, false
166 function Protected_Count
167 (Object
: Entries
.Protection_Entries
'Class;
168 E
: Protected_Entry_Index
)
170 -- Return the number of entry calls to E on Object.
172 function Protected_Entry_Caller
173 (Object
: Entries
.Protection_Entries
'Class) return Task_ID
;
174 -- Return value of E'Caller, where E is the protected entry currently
175 -- being handled. This will only work if called from within an entry
176 -- body, as required by the LRM (C.7.1(14)).
178 -- For internal use only:
180 procedure PO_Do_Or_Queue
182 Object
: Entries
.Protection_Entries_Access
;
183 Entry_Call
: Entry_Call_Link
;
184 With_Abort
: Boolean);
185 -- This procedure either executes or queues an entry call, depending
186 -- on the status of the corresponding barrier. It assumes that abortion
187 -- is deferred and that the specified object is locked.
190 type Communication_Block
is record
192 Enqueued
: Boolean := True;
193 Cancelled
: Boolean := False;
195 pragma Volatile
(Communication_Block
);
198 -- The Communication_Block seems to be a relic.
199 -- At the moment, the compiler seems to be generating
200 -- unnecessary conditional code based on this block.
201 -- See the code generated for async. select with task entry
202 -- call for another way of solving this.
204 end System
.Tasking
.Protected_Objects
.Operations
;