]>
Commit | Line | Data |
---|---|---|
cacbc350 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
07fc65c4 | 3 | -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- |
cacbc350 | 4 | -- -- |
07fc65c4 | 5 | -- SYSTEM.TASKING.PROTECTED_OBJECTS.ENTRIES -- |
cacbc350 RK |
6 | -- -- |
7 | -- S p e c -- | |
8 | -- -- | |
fbf5a39b | 9 | -- Copyright (C) 1992-2002, Free Software Foundation, Inc. -- |
cacbc350 RK |
10 | -- -- |
11 | -- GNARL 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 2, or (at your option) any later ver- -- | |
14 | -- sion. GNARL 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. See the GNU General Public License -- | |
17 | -- for more details. You should have received a copy of the GNU General -- | |
18 | -- Public License distributed with GNARL; see file COPYING. If not, write -- | |
19 | -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- | |
20 | -- MA 02111-1307, USA. -- | |
21 | -- -- | |
22 | -- As a special exception, if other files instantiate generics from this -- | |
23 | -- unit, or you link this unit with other files to produce an executable, -- | |
24 | -- this unit does not by itself cause the resulting executable to be -- | |
25 | -- covered by the GNU General Public License. This exception does not -- | |
26 | -- however invalidate any other reasons why the executable file might be -- | |
27 | -- covered by the GNU Public License. -- | |
28 | -- -- | |
71ff80dc | 29 | -- GNARL was developed by the GNARL team at Florida State University. -- |
fbf5a39b | 30 | -- Extensive contributions were provided by Ada Core Technologies, Inc. -- |
cacbc350 RK |
31 | -- -- |
32 | ------------------------------------------------------------------------------ | |
33 | ||
34 | -- This package contains all the simple primitives related to | |
35 | -- Protected_Objects with entries (i.e init, lock, unlock). | |
36 | -- The handling of protected objects with no entries is done in | |
37 | -- System.Tasking.Protected_Objects, the complex routines for protected | |
38 | -- objects with entries in System.Tasking.Protected_Objects.Operations. | |
39 | -- The split between Entries and Operations is needed to break circular | |
40 | -- dependencies inside the run time. | |
41 | ||
42 | -- Note: the compiler generates direct calls to this interface, via Rtsfind. | |
43 | -- Any changes to this interface may require corresponding compiler changes. | |
44 | ||
45 | with Ada.Finalization; | |
46 | -- used for Limited_Controlled | |
47 | ||
48 | with Unchecked_Conversion; | |
49 | ||
50 | package System.Tasking.Protected_Objects.Entries is | |
51 | pragma Elaborate_Body; | |
52 | ||
53 | subtype Positive_Protected_Entry_Index is | |
54 | Protected_Entry_Index range 1 .. Protected_Entry_Index'Last; | |
55 | ||
56 | type Find_Body_Index_Access is access | |
57 | function | |
58 | (O : System.Address; | |
59 | E : Protected_Entry_Index) | |
60 | return Protected_Entry_Index; | |
61 | ||
62 | type Protected_Entry_Body_Array is | |
63 | array (Positive_Protected_Entry_Index range <>) of Entry_Body; | |
64 | -- This is an array of the executable code for all entry bodies of | |
65 | -- a protected type. | |
66 | ||
67 | type Protected_Entry_Body_Access is access all Protected_Entry_Body_Array; | |
68 | ||
69 | type Protected_Entry_Queue_Array is | |
70 | array (Protected_Entry_Index range <>) of Entry_Queue; | |
71 | ||
72 | -- This type contains the GNARL state of a protected object. The | |
73 | -- application-defined portion of the state (i.e. private objects) | |
74 | -- is maintained by the compiler-generated code. | |
75 | -- note that there is a simplified version of this type declared in | |
76 | -- System.Tasking.PO_Simple that handle the simple case (no entries). | |
77 | ||
78 | type Protection_Entries (Num_Entries : Protected_Entry_Index) is new | |
79 | Ada.Finalization.Limited_Controlled | |
80 | with record | |
81 | L : aliased Task_Primitives.Lock; | |
82 | -- The underlying lock associated with a Protection_Entries. | |
83 | -- Note that you should never (un)lock Object.L directly, but instead | |
84 | -- use Lock_Entries/Unlock_Entries. | |
85 | ||
86 | Compiler_Info : System.Address; | |
87 | Call_In_Progress : Entry_Call_Link; | |
88 | Ceiling : System.Any_Priority; | |
89 | Old_Base_Priority : System.Any_Priority; | |
90 | Pending_Action : Boolean; | |
91 | -- Flag indicating that priority has been dipped temporarily | |
92 | -- in order to avoid violating the priority ceiling of the lock | |
93 | -- associated with this protected object, in Lock_Server. | |
94 | -- The flag tells Unlock_Server or Unlock_And_Update_Server to | |
95 | -- restore the old priority to Old_Base_Priority. This is needed | |
96 | -- because of situations (bad language design?) where one | |
97 | -- needs to lock a PO but to do so would violate the priority | |
98 | -- ceiling. For example, this can happen when an entry call | |
99 | -- has been requeued to a lower-priority object, and the caller | |
100 | -- then tries to cancel the call while its own priority is higher | |
101 | -- than the ceiling of the new PO. | |
102 | Finalized : Boolean := False; | |
103 | -- Set to True by Finalize to make this routine idempotent. | |
104 | ||
105 | Entry_Bodies : Protected_Entry_Body_Access; | |
106 | ||
107 | -- The following function maps the entry index in a call (which denotes | |
108 | -- the queue to the proper entry) into the body of the entry. | |
109 | ||
110 | Find_Body_Index : Find_Body_Index_Access; | |
111 | Entry_Queues : Protected_Entry_Queue_Array (1 .. Num_Entries); | |
112 | end record; | |
cacbc350 RK |
113 | |
114 | -- No default initial values for this type, since call records | |
115 | -- will need to be re-initialized before every use. | |
116 | ||
117 | type Protection_Entries_Access is access all Protection_Entries'Class; | |
118 | -- See comments in s-tassta.adb about the implicit call to Current_Master | |
119 | -- generated by this declaration. | |
120 | ||
cacbc350 RK |
121 | function To_Address is |
122 | new Unchecked_Conversion (Protection_Entries_Access, System.Address); | |
123 | function To_Protection is | |
124 | new Unchecked_Conversion (System.Address, Protection_Entries_Access); | |
125 | ||
126 | function Has_Interrupt_Or_Attach_Handler | |
127 | (Object : Protection_Entries_Access) return Boolean; | |
128 | -- Returns True if an Interrupt_Handler or Attach_Handler pragma applies | |
129 | -- to the protected object. That is to say this primitive returns False for | |
130 | -- Protection, but is overriden to return True when interrupt handlers are | |
131 | -- declared so the check required by C.3.1(11) can be implemented in | |
132 | -- System.Tasking.Protected_Objects.Initialize_Protection. | |
133 | ||
134 | procedure Initialize_Protection_Entries | |
135 | (Object : Protection_Entries_Access; | |
136 | Ceiling_Priority : Integer; | |
137 | Compiler_Info : System.Address; | |
138 | Entry_Bodies : Protected_Entry_Body_Access; | |
139 | Find_Body_Index : Find_Body_Index_Access); | |
140 | -- Initialize the Object parameter so that it can be used by the runtime | |
141 | -- to keep track of the runtime state of a protected object. | |
142 | ||
143 | procedure Lock_Entries (Object : Protection_Entries_Access); | |
144 | -- Lock a protected object for write access. Upon return, the caller | |
145 | -- owns the lock to this object, and no other call to Lock or | |
146 | -- Lock_Read_Only with the same argument will return until the | |
147 | -- corresponding call to Unlock has been made by the caller. | |
148 | -- Program_Error is raised in case of ceiling violation. | |
149 | ||
150 | procedure Lock_Entries | |
151 | (Object : Protection_Entries_Access; Ceiling_Violation : out Boolean); | |
152 | -- Same as above, but return the ceiling violation status instead of | |
153 | -- raising Program_Error. | |
154 | ||
155 | procedure Lock_Read_Only_Entries (Object : Protection_Entries_Access); | |
156 | -- Lock a protected object for read access. Upon return, the caller | |
157 | -- owns the lock for read access, and no other calls to Lock with the | |
158 | -- same argument will return until the corresponding call to Unlock | |
159 | -- has been made by the caller. Other calls to Lock_Read_Only may (but | |
160 | -- need not) return before the call to Unlock, and the corresponding | |
161 | -- callers will also own the lock for read access. | |
162 | -- | |
163 | -- Note: we are not currently using this interface, it is provided | |
164 | -- for possible future use. At the current time, everyone uses Lock | |
165 | -- for both read and write locks. | |
166 | ||
167 | procedure Unlock_Entries (Object : Protection_Entries_Access); | |
168 | -- Relinquish ownership of the lock for the object represented by | |
169 | -- the Object parameter. If this ownership was for write access, or | |
170 | -- if it was for read access where there are no other read access | |
171 | -- locks outstanding, one (or more, in the case of Lock_Read_Only) | |
172 | -- of the tasks waiting on this lock (if any) will be given the | |
173 | -- lock and allowed to return from the Lock or Lock_Read_Only call. | |
174 | ||
175 | private | |
176 | ||
177 | procedure Finalize (Object : in out Protection_Entries); | |
178 | -- Clean up a Protection object; in particular, finalize the associated | |
179 | -- Lock object. | |
180 | ||
181 | end System.Tasking.Protected_Objects.Entries; |