OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c97307a.ada] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn 
-- C97307A.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 
-- CHECK THAT A TIMED ENTRY CALL THAT IS CANCELED (BECAUSE THE DELAY HAS
26 
-- EXPIRED) IS REMOVED FROM THE QUEUE OF THE CALLED TASK'S ENTRY.
27 
 
28 
-- WRG 7/14/86
29 
 
30 
with Impdef;
31 
WITH REPORT; USE REPORT;
32 
PROCEDURE C97307A IS
33 
 
34 
BEGIN
35 
 
36 
     TEST ("C97307A", "CHECK THAT A TIMED ENTRY CALL THAT IS " &
37 
                      "CANCELED (BECAUSE THE DELAY HAS EXPIRED) IS " &
38 
                      "REMOVED FROM THE QUEUE OF THE CALLED TASK'S " &
39 
                      "ENTRY");
40 
 
41 
     DECLARE
42 
 
43 
          DELAY_TIME : CONSTANT DURATION := 2 * 60.0 * Impdef.One_Second;
44 
 
45 
          TASK EXPIRED IS
46 
               ENTRY INCREMENT;
47 
               ENTRY READ (COUNT : OUT NATURAL);
48 
          END EXPIRED;
49 
 
50 
          TASK TYPE NON_TIMED_CALLER IS
51 
               ENTRY NAME (N : NATURAL);
52 
          END NON_TIMED_CALLER;
53 
 
54 
          TASK TYPE TIMED_CALLER IS
55 
               ENTRY NAME (N : NATURAL);
56 
          END TIMED_CALLER;
57 
 
58 
          CALLER1 : TIMED_CALLER;
59 
          CALLER2 : NON_TIMED_CALLER;
60 
          CALLER3 : TIMED_CALLER;
61 
          CALLER4 : NON_TIMED_CALLER;
62 
          CALLER5 : TIMED_CALLER;
63 
 
64 
          TASK T IS
65 
               ENTRY E (NAME : NATURAL);
66 
          END T;
67 
 
68 
          TASK DISPATCH IS
69 
               ENTRY READY;
70 
          END DISPATCH;
71 
 
72 
          --------------------------------------------------
73 
 
74 
          TASK BODY EXPIRED IS
75 
               EXPIRED_CALLS : NATURAL := 0;
76 
          BEGIN
77 
               LOOP
78 
                    SELECT
79 
                         ACCEPT INCREMENT DO
80 
                              EXPIRED_CALLS := EXPIRED_CALLS + 1;
81 
                         END INCREMENT;
82 
                    OR
83 
                         ACCEPT READ (COUNT : OUT NATURAL) DO
84 
                              COUNT := EXPIRED_CALLS;
85 
                         END READ;
86 
                    OR
87 
                         TERMINATE;
88 
                    END SELECT;
89 
               END LOOP;
90 
          END EXPIRED;
91 
 
92 
          --------------------------------------------------
93 
 
94 
          TASK BODY NON_TIMED_CALLER IS
95 
               MY_NAME : NATURAL;
96 
          BEGIN
97 
               ACCEPT NAME (N : NATURAL) DO
98 
                    MY_NAME := N;
99 
               END NAME;
100 
 
101 
               T.E (MY_NAME);
102 
          END NON_TIMED_CALLER;
103 
 
104 
          --------------------------------------------------
105 
 
106 
          TASK BODY TIMED_CALLER IS
107 
               MY_NAME : NATURAL;
108 
          BEGIN
109 
               ACCEPT NAME (N : NATURAL) DO
110 
                    MY_NAME := N;
111 
               END NAME;
112 
 
113 
               SELECT
114 
                    T.E (MY_NAME);
115 
                    FAILED ("TIMED ENTRY CALL NOT CANCELED FOR CALLER" &
116 
                            NATURAL'IMAGE(MY_NAME));
117 
               OR
118 
                    DELAY DELAY_TIME;
119 
                    EXPIRED.INCREMENT;
120 
               END SELECT;
121 
          EXCEPTION
122 
               WHEN OTHERS =>
123 
                    FAILED ("EXCEPTION RAISED IN TIMED_CALLER -- " &
124 
                            "CALLER" & NATURAL'IMAGE(MY_NAME));
125 
          END TIMED_CALLER;
126 
 
127 
          --------------------------------------------------
128 
 
129 
          TASK BODY DISPATCH IS
130 
          BEGIN
131 
               CALLER1.NAME (1);
132 
               ACCEPT READY;
133 
 
134 
               CALLER2.NAME (2);
135 
               ACCEPT READY;
136 
 
137 
               CALLER3.NAME (3);
138 
               ACCEPT READY;
139 
 
140 
               CALLER4.NAME (4);
141 
               ACCEPT READY;
142 
 
143 
               CALLER5.NAME (5);
144 
          END DISPATCH;
145 
 
146 
          --------------------------------------------------
147 
 
148 
          TASK BODY T IS
149 
 
150 
               DESIRED_QUEUE_LENGTH : NATURAL := 1;
151 
               EXPIRED_CALLS        : NATURAL;
152 
 
153 
               ACCEPTED             : ARRAY (1..5) OF NATURAL RANGE 0..5
154 
                                         := (OTHERS => 0);
155 
               ACCEPTED_INDEX       : NATURAL := 0;
156 
 
157 
          BEGIN
158 
               LOOP
159 
                    LOOP
160 
                         EXPIRED.READ (EXPIRED_CALLS);
161 
                    EXIT WHEN E'COUNT >= DESIRED_QUEUE_LENGTH -
162 
                                         EXPIRED_CALLS;
163 
                         DELAY 2.0 * Impdef.One_Long_Second;
164 
                    END LOOP;
165 
               EXIT WHEN DESIRED_QUEUE_LENGTH = 5;
166 
                    DISPATCH.READY;
167 
                    DESIRED_QUEUE_LENGTH := DESIRED_QUEUE_LENGTH + 1;
168 
               END LOOP;
169 
 
170 
               -- AT THIS POINT, FIVE TASKS WERE QUEUED.
171 
               -- LET THE TIMED ENTRY CALLS ISSUED BY CALLER1,
172 
               -- CALLER3, AND CALLER5 EXPIRE:
173 
 
174 
               DELAY DELAY_TIME + 10.0 * Impdef.One_Long_Second;
175 
 
176 
               -- AT THIS POINT, ALL THE TIMED ENTRY CALLS MUST HAVE
177 
               -- EXPIRED AND BEEN REMOVED FROM THE ENTRY QUEUE FOR E,
178 
               -- OTHERWISE THE IMPLEMENTATION HAS FAILED THIS TEST.
179 
 
180 
               WHILE E'COUNT > 0 LOOP
181 
                    ACCEPT E (NAME : NATURAL) DO
182 
                         ACCEPTED_INDEX := ACCEPTED_INDEX + 1;
183 
                         ACCEPTED (ACCEPTED_INDEX) := NAME;
184 
                    END E;
185 
               END LOOP;
186 
 
187 
               IF ACCEPTED /= (2, 4, 0, 0, 0) THEN
188 
                    FAILED ("SOME TIMED CALLS NOT REMOVED FROM ENTRY " &
189 
                            "QUEUE");
190 
                    COMMENT ("ORDER ACCEPTED WAS:" &
191 
                             NATURAL'IMAGE (ACCEPTED (1))  & ',' &
192 
                             NATURAL'IMAGE (ACCEPTED (2))  & ',' &
193 
                             NATURAL'IMAGE (ACCEPTED (3))  & ',' &
194 
                             NATURAL'IMAGE (ACCEPTED (4))  & ',' &
195 
                             NATURAL'IMAGE (ACCEPTED (5)) );
196 
               END IF;
197 
          END T;
198 
 
199 
          --------------------------------------------------
200 
 
201 
     BEGIN
202 
 
203 
          NULL;
204 
 
205 
     END;
206 
 
207 
     RESULT;
208 
 
209 
END C97307A;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.