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 32WITH CC3019C0_LIST_CLASS ; 33 34GENERIC 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 44PACKAGE 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 138PRIVATE 139 140 TYPE NESTED_GENERICS_TYPE IS RECORD 141 FIRST : ELEMENT ; 142 SECOND : NATURAL ; 143 END RECORD ; 144 145END CC3019C1_NESTED_GENERICS ; 146 147PACKAGE 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 331END CC3019C1_NESTED_GENERICS ; 332