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
|
------------------------------------------------------------------------------
-- --
-- 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 . --
-- E N T R I E S --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, 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 2, or (at your option) any later ver- --
-- sion. GNARL 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNARL; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
-- This package contains all the simple primitives related to
-- Protected_Objects with entries (i.e init, lock, unlock).
-- The handling of protected objects with no entries is done in
-- System.Tasking.Protected_Objects, the complex routines for protected
-- objects with entries in System.Tasking.Protected_Objects.Operations.
-- The split between Entries and Operations is needed to break circular
-- dependencies inside the run time.
-- Note: the compiler generates direct calls to this interface, via Rtsfind.
-- Any changes to this interface may require corresponding compiler changes.
with Ada.Finalization;
-- used for Limited_Controlled
with Ada.Unchecked_Conversion;
package System.Tasking.Protected_Objects.Entries is
pragma Elaborate_Body;
subtype Positive_Protected_Entry_Index is
Protected_Entry_Index range 1 .. Protected_Entry_Index'Last;
type Find_Body_Index_Access is access
function
(O : System.Address;
E : Protected_Entry_Index)
return Protected_Entry_Index;
type Protected_Entry_Body_Array is
array (Positive_Protected_Entry_Index range <>) of Entry_Body;
-- This is an array of the executable code for all entry bodies of
-- a protected type.
type Protected_Entry_Body_Access is access all Protected_Entry_Body_Array;
type Protected_Entry_Queue_Array is
array (Protected_Entry_Index range <>) of Entry_Queue;
-- 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 is a simplified version of this type declared in
-- System.Tasking.PO_Simple that handle the simple case (no entries).
type Protection_Entries (Num_Entries : Protected_Entry_Index) is new
Ada.Finalization.Limited_Controlled
with record
L : aliased Task_Primitives.Lock;
-- The underlying lock associated with a Protection_Entries.
-- Note that you should never (un)lock Object.L directly, but instead
-- use Lock_Entries/Unlock_Entries.
Compiler_Info : System.Address;
-- Pointer to compiler-generated record representing protected object
Call_In_Progress : Entry_Call_Link;
-- Pointer to the entry call being executed (if any)
Ceiling : System.Any_Priority;
-- Ceiling priority associated with 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).
Old_Base_Priority : System.Any_Priority;
-- Task's base priority when the protected operation was called
Pending_Action : Boolean;
-- Flag indicating that priority has been dipped temporarily in order
-- to avoid violating the priority ceiling of the lock associated with
-- this protected object, in Lock_Server. The flag tells Unlock_Server
-- or Unlock_And_Update_Server to restore the old priority to
-- Old_Base_Priority. This is needed because of situations (bad
-- language design?) where one needs to lock a PO but to do so would
-- violate the priority ceiling. For example, this can happen when an
-- entry call has been requeued to a lower-priority object, and the
-- caller then tries to cancel the call while its own priority is
-- higher than the ceiling of the new PO.
Finalized : Boolean := False;
-- Set to True by Finalize to make this routine idempotent
Entry_Bodies : Protected_Entry_Body_Access;
-- Pointer to an array containing the executable code for all entry
-- bodies of a protected type.
-- The following function maps the entry index in a call (which denotes
-- the queue to the proper entry) into the body of the entry.
Find_Body_Index : Find_Body_Index_Access;
Entry_Queues : Protected_Entry_Queue_Array (1 .. Num_Entries);
end record;
-- No default initial values for this type, since call records
-- will need to be re-initialized before every use.
type Protection_Entries_Access is access all Protection_Entries'Class;
-- See comments in s-tassta.adb about the implicit call to Current_Master
-- generated by this declaration.
function To_Address is
new Ada.Unchecked_Conversion (Protection_Entries_Access, System.Address);
function To_Protection is
new Ada.Unchecked_Conversion (System.Address, Protection_Entries_Access);
function Get_Ceiling
(Object : Protection_Entries_Access) return System.Any_Priority;
-- Returns the new ceiling priority of the protected object
function Has_Interrupt_Or_Attach_Handler
(Object : Protection_Entries_Access) return Boolean;
-- Returns True if an Interrupt_Handler or Attach_Handler pragma applies
-- to the protected object. That is to say this primitive returns False for
-- Protection, but is overriden to return True when interrupt handlers are
-- declared so the check required by C.3.1(11) can be implemented in
-- System.Tasking.Protected_Objects.Initialize_Protection.
procedure Initialize_Protection_Entries
(Object : Protection_Entries_Access;
Ceiling_Priority : Integer;
Compiler_Info : System.Address;
Entry_Bodies : Protected_Entry_Body_Access;
Find_Body_Index : Find_Body_Index_Access);
-- 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_Entries (Object : Protection_Entries_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. Program_Error is raised in case of
-- ceiling violation.
procedure Lock_Entries
(Object : Protection_Entries_Access;
Ceiling_Violation : out Boolean);
-- Same as above, but return the ceiling violation status instead of
-- raising Program_Error.
procedure Lock_Read_Only_Entries (Object : Protection_Entries_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_Entries_Access;
Prio : System.Any_Priority);
-- Sets the new ceiling priority of the protected object
procedure Unlock_Entries (Object : Protection_Entries_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
procedure Finalize (Object : in out Protection_Entries);
-- Clean up a Protection object; in particular, finalize the associated
-- Lock object.
end System.Tasking.Protected_Objects.Entries;
|
