|
111
|
1 -- CC3019C1.ADA
|
|
|
2
|
|
|
3 -- Grant of Unlimited Rights
|
|
|
4 --
|
|
|
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
|
|
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
|
|
7 -- unlimited rights in the software and documentation contained herein.
|
|
|
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
|
|
9 -- this public release, the Government intends to confer upon all
|
|
|
10 -- recipients unlimited rights equal to those held by the Government.
|
|
|
11 -- These rights include rights to use, duplicate, release or disclose the
|
|
|
12 -- released technical data and computer software in whole or in part, in
|
|
|
13 -- any manner and for any purpose whatsoever, and to have or permit others
|
|
|
14 -- to do so.
|
|
|
15 --
|
|
|
16 -- DISCLAIMER
|
|
|
17 --
|
|
|
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
|
|
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
|
|
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
|
|
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
|
|
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
|
|
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
|
|
|
24 --*
|
|
|
25 -- THIS IS GENERIC PACKAGE WHICH IS USED TO CHECK THE LEVEL OF
|
|
|
26 -- NESTED GENERICS SUPPORTED BY AN IMPLEMENTATION. IT IS USED
|
|
|
27 -- BY MAIN PROCEDURE CC3019C2M.ADA.
|
|
|
28 --
|
|
|
29 -- HISTORY:
|
|
|
30 -- EDWARD V. BERARD, 31 AUGUST 1990
|
|
|
31
|
|
|
32 WITH CC3019C0_LIST_CLASS ;
|
|
|
33
|
|
|
34 GENERIC
|
|
|
35
|
|
|
36 TYPE ELEMENT IS LIMITED PRIVATE ;
|
|
|
37
|
|
|
38 WITH PROCEDURE ASSIGN (SOURCE : IN OUT ELEMENT ;
|
|
|
39 DESTINATION : IN OUT ELEMENT) ;
|
|
|
40
|
|
|
41 WITH FUNCTION "=" (LEFT : IN ELEMENT ;
|
|
|
42 RIGHT : IN ELEMENT) RETURN BOOLEAN ;
|
|
|
43
|
|
|
44 PACKAGE CC3019C1_NESTED_GENERICS IS
|
|
|
45
|
|
|
46 TYPE NESTED_GENERICS_TYPE IS LIMITED PRIVATE ;
|
|
|
47
|
|
|
48 PROCEDURE COPY (SOURCE : IN OUT NESTED_GENERICS_TYPE ;
|
|
|
49 DESTINATION : IN OUT NESTED_GENERICS_TYPE) ;
|
|
|
50
|
|
|
51 PROCEDURE SET_ELEMENT
|
|
|
52 (FOR_THIS_NGT_OBJECT : IN OUT NESTED_GENERICS_TYPE ;
|
|
|
53 TO_THIS_ELEMENT : IN OUT ELEMENT) ;
|
|
|
54
|
|
|
55 PROCEDURE SET_NUMBER
|
|
|
56 (FOR_THIS_NGT_OBJECT : IN OUT NESTED_GENERICS_TYPE ;
|
|
|
57 TO_THIS_NUMBER : IN NATURAL) ;
|
|
|
58
|
|
|
59 FUNCTION "=" (LEFT : IN NESTED_GENERICS_TYPE ;
|
|
|
60 RIGHT : IN NESTED_GENERICS_TYPE) RETURN BOOLEAN ;
|
|
|
61
|
|
|
62 FUNCTION ELEMENT_OF (THIS_NGT_OBJECT : IN NESTED_GENERICS_TYPE)
|
|
|
63 RETURN ELEMENT ;
|
|
|
64
|
|
|
65 FUNCTION NUMBER_OF (THIS_NGT_OBJECT : IN NESTED_GENERICS_TYPE)
|
|
|
66 RETURN NATURAL ;
|
|
|
67
|
|
|
68 GENERIC
|
|
|
69
|
|
|
70 TYPE ELEMENT IS LIMITED PRIVATE ;
|
|
|
71
|
|
|
72 WITH PROCEDURE ASSIGN (SOURCE : IN OUT ELEMENT ;
|
|
|
73 DESTINATION : IN OUT ELEMENT) ;
|
|
|
74
|
|
|
75 PACKAGE GENERIC_TASK IS
|
|
|
76
|
|
|
77 TASK TYPE PROTECTED_AREA IS
|
|
|
78
|
|
|
79 ENTRY STORE (ITEM : IN OUT ELEMENT) ;
|
|
|
80 ENTRY GET (ITEM : IN OUT ELEMENT) ;
|
|
|
81
|
|
|
82 END PROTECTED_AREA ;
|
|
|
83
|
|
|
84 END GENERIC_TASK ;
|
|
|
85
|
|
|
86 GENERIC
|
|
|
87
|
|
|
88 TYPE ELEMENT IS LIMITED PRIVATE ;
|
|
|
89
|
|
|
90 WITH PROCEDURE ASSIGN (SOURCE : IN OUT ELEMENT ;
|
|
|
91 DESTINATION : IN OUT ELEMENT) ;
|
|
|
92
|
|
|
93 WITH FUNCTION "=" (LEFT : IN ELEMENT ;
|
|
|
94 RIGHT : IN ELEMENT) RETURN BOOLEAN ;
|
|
|
95
|
|
|
96 PACKAGE STACK_CLASS IS
|
|
|
97
|
|
|
98 TYPE STACK IS LIMITED PRIVATE ;
|
|
|
99
|
|
|
100 OVERFLOW : EXCEPTION ;
|
|
|
101 UNDERFLOW : EXCEPTION ;
|
|
|
102
|
|
|
103 PROCEDURE PUSH (THIS_ELEMENT : IN OUT ELEMENT ;
|
|
|
104 ON_TO_THIS_STACK : IN OUT STACK) ;
|
|
|
105
|
|
|
106 PROCEDURE POP (THIS_ELEMENT : IN OUT ELEMENT ;
|
|
|
107 OFF_THIS_STACK : IN OUT STACK) ;
|
|
|
108
|
|
|
109 PROCEDURE COPY (THIS_STACK : IN OUT STACK ;
|
|
|
110 TO_THIS_STACK : IN OUT STACK) ;
|
|
|
111
|
|
|
112 PROCEDURE CLEAR (THIS_STACK : IN OUT STACK) ;
|
|
|
113
|
|
|
114 GENERIC
|
|
|
115
|
|
|
116 WITH PROCEDURE PROCESS (THIS_ELEMENT : IN ELEMENT ;
|
|
|
117 CONTINUE : OUT BOOLEAN) ;
|
|
|
118
|
|
|
119 PROCEDURE ITERATE (OVER_THIS_STACK : IN STACK) ;
|
|
|
120
|
|
|
121 FUNCTION NUMBER_OF_ELEMENTS (ON_THIS_STACK : IN STACK)
|
|
|
122 RETURN NATURAL ;
|
|
|
123
|
|
|
124 FUNCTION "=" (LEFT : IN STACK ;
|
|
|
125 RIGHT : IN STACK) RETURN BOOLEAN ;
|
|
|
126
|
|
|
127 PRIVATE
|
|
|
128
|
|
|
129 PACKAGE NEW_LIST_CLASS IS NEW
|
|
|
130 CC3019C0_LIST_CLASS (ELEMENT => ELEMENT,
|
|
|
131 ASSIGN => ASSIGN,
|
|
|
132 "=" => "=") ;
|
|
|
133
|
|
|
134 TYPE STACK IS NEW NEW_LIST_CLASS.LIST ;
|
|
|
135
|
|
|
136 END STACK_CLASS ;
|
|
|
137
|
|
|
138 PRIVATE
|
|
|
139
|
|
|
140 TYPE NESTED_GENERICS_TYPE IS RECORD
|
|
|
141 FIRST : ELEMENT ;
|
|
|
142 SECOND : NATURAL ;
|
|
|
143 END RECORD ;
|
|
|
144
|
|
|
145 END CC3019C1_NESTED_GENERICS ;
|
|
|
146
|
|
|
147 PACKAGE BODY CC3019C1_NESTED_GENERICS IS
|
|
|
148
|
|
|
149 PROCEDURE COPY (SOURCE : IN OUT NESTED_GENERICS_TYPE ;
|
|
|
150 DESTINATION : IN OUT NESTED_GENERICS_TYPE) IS
|
|
|
151
|
|
|
152 BEGIN -- COPY
|
|
|
153
|
|
|
154 ASSIGN (SOURCE => SOURCE.FIRST,
|
|
|
155 DESTINATION => DESTINATION.FIRST) ;
|
|
|
156
|
|
|
157 DESTINATION.SECOND := SOURCE.SECOND ;
|
|
|
158
|
|
|
159 END COPY ;
|
|
|
160
|
|
|
161 PROCEDURE SET_ELEMENT
|
|
|
162 (FOR_THIS_NGT_OBJECT : IN OUT NESTED_GENERICS_TYPE ;
|
|
|
163 TO_THIS_ELEMENT : IN OUT ELEMENT) IS
|
|
|
164
|
|
|
165 BEGIN -- SET_ELEMENT
|
|
|
166
|
|
|
167 ASSIGN (SOURCE => TO_THIS_ELEMENT,
|
|
|
168 DESTINATION => FOR_THIS_NGT_OBJECT.FIRST) ;
|
|
|
169
|
|
|
170 END SET_ELEMENT ;
|
|
|
171
|
|
|
172 PROCEDURE SET_NUMBER
|
|
|
173 (FOR_THIS_NGT_OBJECT : IN OUT NESTED_GENERICS_TYPE ;
|
|
|
174 TO_THIS_NUMBER : IN NATURAL) IS
|
|
|
175
|
|
|
176 BEGIN -- SET_NUMBER
|
|
|
177
|
|
|
178 FOR_THIS_NGT_OBJECT.SECOND := TO_THIS_NUMBER ;
|
|
|
179
|
|
|
180 END SET_NUMBER ;
|
|
|
181
|
|
|
182 FUNCTION "=" (LEFT : IN NESTED_GENERICS_TYPE ;
|
|
|
183 RIGHT : IN NESTED_GENERICS_TYPE) RETURN BOOLEAN IS
|
|
|
184
|
|
|
185 BEGIN -- "="
|
|
|
186
|
|
|
187 IF (LEFT.FIRST = RIGHT.FIRST) AND
|
|
|
188 (LEFT.SECOND = RIGHT.SECOND) THEN
|
|
|
189 RETURN TRUE ;
|
|
|
190 ELSE
|
|
|
191 RETURN FALSE ;
|
|
|
192 END IF ;
|
|
|
193
|
|
|
194 END "=" ;
|
|
|
195
|
|
|
196 FUNCTION ELEMENT_OF (THIS_NGT_OBJECT : IN NESTED_GENERICS_TYPE)
|
|
|
197 RETURN ELEMENT IS
|
|
|
198
|
|
|
199 BEGIN -- ELEMENT_OF
|
|
|
200
|
|
|
201 RETURN THIS_NGT_OBJECT.FIRST ;
|
|
|
202
|
|
|
203 END ELEMENT_OF ;
|
|
|
204
|
|
|
205 FUNCTION NUMBER_OF (THIS_NGT_OBJECT : IN NESTED_GENERICS_TYPE)
|
|
|
206 RETURN NATURAL IS
|
|
|
207
|
|
|
208 BEGIN -- NUMBER_OF
|
|
|
209
|
|
|
210 RETURN THIS_NGT_OBJECT.SECOND ;
|
|
|
211
|
|
|
212 END NUMBER_OF ;
|
|
|
213
|
|
|
214 PACKAGE BODY GENERIC_TASK IS
|
|
|
215
|
|
|
216 TASK BODY PROTECTED_AREA IS
|
|
|
217
|
|
|
218 LOCAL_STORE : ELEMENT ;
|
|
|
219
|
|
|
220 BEGIN -- PROTECTED_AREA
|
|
|
221
|
|
|
222 LOOP
|
|
|
223 SELECT
|
|
|
224 ACCEPT STORE (ITEM : IN OUT ELEMENT) DO
|
|
|
225 ASSIGN (SOURCE => ITEM,
|
|
|
226 DESTINATION => LOCAL_STORE) ;
|
|
|
227 END STORE ;
|
|
|
228 OR
|
|
|
229 ACCEPT GET (ITEM : IN OUT ELEMENT) DO
|
|
|
230 ASSIGN (SOURCE => LOCAL_STORE,
|
|
|
231 DESTINATION => ITEM) ;
|
|
|
232 END GET ;
|
|
|
233 OR
|
|
|
234 TERMINATE ;
|
|
|
235 END SELECT ;
|
|
|
236 END LOOP ;
|
|
|
237
|
|
|
238 END PROTECTED_AREA ;
|
|
|
239
|
|
|
240 END GENERIC_TASK ;
|
|
|
241
|
|
|
242 PACKAGE BODY STACK_CLASS IS
|
|
|
243
|
|
|
244 PROCEDURE PUSH (THIS_ELEMENT : IN OUT ELEMENT ;
|
|
|
245 ON_TO_THIS_STACK : IN OUT STACK) IS
|
|
|
246
|
|
|
247 BEGIN -- PUSH
|
|
|
248
|
|
|
249 NEW_LIST_CLASS.ADD (
|
|
|
250 THIS_ELEMENT => THIS_ELEMENT,
|
|
|
251 TO_THIS_LIST =>
|
|
|
252 NEW_LIST_CLASS.LIST (ON_TO_THIS_STACK)) ;
|
|
|
253
|
|
|
254 EXCEPTION
|
|
|
255
|
|
|
256 WHEN NEW_LIST_CLASS.OVERFLOW => RAISE OVERFLOW ;
|
|
|
257
|
|
|
258 END PUSH ;
|
|
|
259
|
|
|
260 PROCEDURE POP (THIS_ELEMENT : IN OUT ELEMENT ;
|
|
|
261 OFF_THIS_STACK : IN OUT STACK) IS
|
|
|
262
|
|
|
263 BEGIN -- POP
|
|
|
264
|
|
|
265 NEW_LIST_CLASS.DELETE (
|
|
|
266 THIS_ELEMENT => THIS_ELEMENT,
|
|
|
267 FROM_THIS_LIST =>
|
|
|
268 NEW_LIST_CLASS.LIST (OFF_THIS_STACK)) ;
|
|
|
269
|
|
|
270 EXCEPTION
|
|
|
271
|
|
|
272 WHEN NEW_LIST_CLASS.UNDERFLOW => RAISE UNDERFLOW ;
|
|
|
273
|
|
|
274 END POP ;
|
|
|
275
|
|
|
276 PROCEDURE COPY (THIS_STACK : IN OUT STACK ;
|
|
|
277 TO_THIS_STACK : IN OUT STACK) IS
|
|
|
278
|
|
|
279 BEGIN -- COPY
|
|
|
280
|
|
|
281 NEW_LIST_CLASS.COPY (
|
|
|
282 THIS_LIST => NEW_LIST_CLASS.LIST (THIS_STACK),
|
|
|
283 TO_THIS_LIST =>
|
|
|
284 NEW_LIST_CLASS.LIST (TO_THIS_STACK)) ;
|
|
|
285
|
|
|
286 END COPY ;
|
|
|
287
|
|
|
288 PROCEDURE CLEAR (THIS_STACK : IN OUT STACK) IS
|
|
|
289
|
|
|
290 BEGIN -- CLEAR
|
|
|
291
|
|
|
292 NEW_LIST_CLASS.CLEAR (NEW_LIST_CLASS.LIST (THIS_STACK)) ;
|
|
|
293
|
|
|
294 END CLEAR ;
|
|
|
295
|
|
|
296 PROCEDURE ITERATE (OVER_THIS_STACK : IN STACK) IS
|
|
|
297
|
|
|
298 PROCEDURE STACK_ITERATE IS NEW NEW_LIST_CLASS.ITERATE
|
|
|
299 (PROCESS => PROCESS) ;
|
|
|
300
|
|
|
301 BEGIN -- ITERATE
|
|
|
302
|
|
|
303 STACK_ITERATE (NEW_LIST_CLASS.LIST (OVER_THIS_STACK)) ;
|
|
|
304
|
|
|
305 END ITERATE ;
|
|
|
306
|
|
|
307 FUNCTION NUMBER_OF_ELEMENTS (ON_THIS_STACK : IN STACK)
|
|
|
308 RETURN NATURAL IS
|
|
|
309
|
|
|
310 BEGIN -- NUMBER_OF_ELEMENTS
|
|
|
311
|
|
|
312 RETURN NEW_LIST_CLASS.NUMBER_OF_ELEMENTS
|
|
|
313 (IN_THIS_LIST =>
|
|
|
314 NEW_LIST_CLASS.LIST (ON_THIS_STACK)) ;
|
|
|
315
|
|
|
316 END NUMBER_OF_ELEMENTS ;
|
|
|
317
|
|
|
318 FUNCTION "=" (LEFT : IN STACK ;
|
|
|
319 RIGHT : IN STACK) RETURN BOOLEAN IS
|
|
|
320
|
|
|
321 BEGIN -- "="
|
|
|
322
|
|
|
323 RETURN NEW_LIST_CLASS."=" (
|
|
|
324 LEFT => NEW_LIST_CLASS.LIST (LEFT),
|
|
|
325 RIGHT => NEW_LIST_CLASS.LIST (RIGHT)) ;
|
|
|
326
|
|
|
327 END "=" ;
|
|
|
328
|
|
|
329 END STACK_CLASS ;
|
|
|
330
|
|
|
331 END CC3019C1_NESTED_GENERICS ;
|
