1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
|
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- 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 --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
-- This package provides necessary definitions to handle simple (i.e without
-- entries) protected objects.
-- All the routines that handle protected objects with entries have been moved
-- to two children: Entries and Operations. Note that Entries only contains
-- the type declaration and the OO primitives. This is needed to avoid
-- circular dependency.
-- This package is part of the high level tasking interface used by the
-- compiler to expand Ada 95 tasking constructs into simpler run time calls
-- (aka GNARLI, GNU Ada Run-time Library Interface)
-- Note: the compiler generates direct calls to this interface, via Rtsfind.
-- Any changes to this interface may require corresponding compiler changes
-- in exp_ch9.adb and possibly exp_ch7.adb and exp_attr.adb
package System.Tasking.Protected_Objects is
pragma Elaborate_Body;
---------------------------------
-- Compiler Interface (GNARLI) --
---------------------------------
-- The compiler will expand in the GNAT tree the following construct:
-- protected PO is
-- procedure P;
-- private
-- open : boolean := false;
-- end PO;
-- protected body PO is
-- procedure P is
-- ...variable declarations...
-- begin
-- ...B...
-- end P;
-- end PO;
-- as follows:
-- protected type poT is
-- procedure p;
-- private
-- open : boolean := false;
-- end poT;
-- type poTV is limited record
-- open : boolean := false;
-- _object : aliased protection;
-- end record;
-- procedure poPT__pN (_object : in out poTV);
-- procedure poPT__pP (_object : in out poTV);
-- freeze poTV [
-- procedure poTVI (_init : in out poTV) is
-- begin
-- _init.open := false;
-- object-init-proc (_init._object);
-- initialize_protection (_init._object'unchecked_access,
-- unspecified_priority);
-- return;
-- end _init_proc;
-- ]
-- po : poT;
-- poTVI (poTV!(po));
-- procedure poPT__pN (_object : in out poTV) is
-- poR : protection renames _object._object;
-- openP : boolean renames _object.open;
-- ...variable declarations...
-- begin
-- ...B...
-- return;
-- end poPT__pN;
-- procedure poPT__pP (_object : in out poTV) is
-- procedure _clean is
-- begin
-- unlock (_object._object'unchecked_access);
-- return;
-- end _clean;
-- begin
-- lock (_object._object'unchecked_access);
-- B2b : begin
-- poPT__pN (_object);
-- at end
-- _clean;
-- end B2b;
-- return;
-- end poPT__pP;
Null_Protected_Entry : constant := Null_Entry;
Max_Protected_Entry : constant := Max_Entry;
type Protected_Entry_Index is new Entry_Index
range Null_Protected_Entry .. Max_Protected_Entry;
type Barrier_Function_Pointer is access
function
(O : System.Address;
E : Protected_Entry_Index)
return Boolean;
-- Pointer to a function which evaluates the barrier of a protected
-- entry body. O is a pointer to the compiler-generated record
-- representing the protected object, and E is the index of the
-- entry serviced by the body.
type Entry_Action_Pointer is access
procedure
(O : System.Address;
P : System.Address;
E : Protected_Entry_Index);
-- Pointer to a procedure which executes the sequence of statements
-- of a protected entry body. O is a pointer to the compiler-generated
-- record representing the protected object, P is a pointer to the
-- record of entry parameters, and E is the index of the
-- entry serviced by the body.
type Entry_Body is record
Barrier : Barrier_Function_Pointer;
Action : Entry_Action_Pointer;
end record;
-- The compiler-generated code passes objects of this type to the GNARL
-- to allow it to access the executable code of an entry body.
type Entry_Body_Access is access all Entry_Body;
type Protection is limited private;
-- This type contains the GNARL state of a protected object. The
-- application-defined portion of the state (i.e. private objects)
-- is maintained by the compiler-generated code.
-- Note that there are now 2 Protection types. One for the simple
-- case (no entries) and one for the general case that needs the whole
-- Finalization mechanism.
-- This split helps in the case of restricted run time where we want to
-- minimize the size of the code.
type Protection_Access is access all Protection;
Null_PO : constant Protection_Access := null;
function Get_Ceiling
(Object : Protection_Access) return System.Any_Priority;
-- Returns the new ceiling priority of the protected object
procedure Initialize_Protection
(Object : Protection_Access;
Ceiling_Priority : Integer);
-- Initialize the Object parameter so that it can be used by the runtime
-- to keep track of the runtime state of a protected object.
procedure Lock (Object : Protection_Access);
-- Lock a protected object for write access. Upon return, the caller
-- owns the lock to this object, and no other call to Lock or
-- Lock_Read_Only with the same argument will return until the
-- corresponding call to Unlock has been made by the caller.
procedure Lock_Read_Only (Object : Protection_Access);
-- Lock a protected object for read access. Upon return, the caller
-- owns the lock for read access, and no other calls to Lock with the
-- same argument will return until the corresponding call to Unlock
-- has been made by the caller. Other calls to Lock_Read_Only may (but
-- need not) return before the call to Unlock, and the corresponding
-- callers will also own the lock for read access.
--
-- Note: we are not currently using this interface, it is provided
-- for possible future use. At the current time, everyone uses Lock
-- for both read and write locks.
procedure Set_Ceiling
(Object : Protection_Access;
Prio : System.Any_Priority);
-- Sets the new ceiling priority of the protected object
procedure Unlock (Object : Protection_Access);
-- Relinquish ownership of the lock for the object represented by
-- the Object parameter. If this ownership was for write access, or
-- if it was for read access where there are no other read access
-- locks outstanding, one (or more, in the case of Lock_Read_Only)
-- of the tasks waiting on this lock (if any) will be given the
-- lock and allowed to return from the Lock or Lock_Read_Only call.
private
type Protection is record
L : aliased Task_Primitives.Lock;
-- Lock used to ensure mutual exclusive access to the protected object
Ceiling : System.Any_Priority;
-- Ceiling priority associated to the protected object
New_Ceiling : System.Any_Priority;
-- New ceiling priority associated to the protected object. In case
-- of assignment of a new ceiling priority to the protected object the
-- frontend generates a call to set_ceiling to save the new value in
-- this field. After such assignment this value can be read by means
-- of the 'Priority attribute, which generates a call to get_ceiling.
-- However, the ceiling of the protected object will not be changed
-- until completion of the protected action in which the assignment
-- has been executed (AARM D.5.2 (10/2)).
Owner : Task_Id;
-- This field contains the protected object's owner. Null_Task
-- indicates that the protected object is not currently being used.
-- This information is used for detecting the type of potentially
-- blocking operations described in the ARM 9.5.1, par. 15 (external
-- calls on a protected subprogram with the same target object as that
-- of the protected action).
end record;
procedure Finalize_Protection (Object : in out Protection);
-- Clean up a Protection object (in particular, finalize the associated
-- Lock object). The compiler generates calls automatically to this
-- procedure
end System.Tasking.Protected_Objects;
|
