source: rtems/c/src/ada-tests/sptests/sp19/sptest.adp @ 1ceb844

4.104.114.84.95
Last change on this file since 1ceb844 was 1ceb844, checked in by Joel Sherrill <joel.sherrill@…>, on Sep 4, 2003 at 1:46:40 PM

2003-09-04 Joel Sherrill <joel@…>

  • sptests/sp19/sptest.adp, support/init.c: Removed incorrect statement about copyright assignment.
  • Property mode set to 100644
File size: 10.5 KB
Line 
1--
2--  SPTEST / BODY
3--
4--  DESCRIPTION:
5--
6--  This package is the implementation of Test 19 of the RTEMS
7--  Single Processor Test Suite.
8--
9--  DEPENDENCIES:
10--
11-- 
12--
13--  COPYRIGHT (c) 1989, 1990, 1991, 1992, 1993, 1994.
14--  On-Line Applications Research Corporation (OAR).
15--
16--  $Id$
17--
18
19with INTERFACES; use INTERFACES;
20with FLOAT_IO;
21with RTEMS;
22with TEST_SUPPORT;
23with TEXT_IO;
24with UNSIGNED32_IO;
25
26include(../../support/fp.inc)
27include(../../support/integer.inc)
28
29package body SPTEST is
30
31--PAGE
32--
33--  INIT
34--
35
36   procedure INIT (
37      ARGUMENT : in     RTEMS.TASK_ARGUMENT
38   ) is
39      STATUS : RTEMS.STATUS_CODES;
40   begin
41
42      TEXT_IO.NEW_LINE( 2 );
43      TEXT_IO.PUT_LINE( "*** TEST 19 ***" );
44
45      SPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME(  'T', 'A', '1', ' ' );
46      SPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME(  'T', 'A', '2', ' ' );
47      SPTEST.TASK_NAME( 3 ) := RTEMS.BUILD_NAME(  'T', 'A', '3', ' ' );
48      SPTEST.TASK_NAME( 4 ) := RTEMS.BUILD_NAME(  'T', 'A', '4', ' ' );
49      SPTEST.TASK_NAME( 5 ) := RTEMS.BUILD_NAME(  'T', 'A', '5', ' ' );
50      SPTEST.TASK_NAME( 6 ) := RTEMS.BUILD_NAME(  'F', 'P', '1', ' ' );
51
52      RTEMS.TASK_CREATE(
53         SPTEST.TASK_NAME( 1 ),
54         2,
55         2048,
56         RTEMS.DEFAULT_MODES,
57         RTEMS.FLOATING_POINT,
58         SPTEST.TASK_ID( 1 ),
59         STATUS
60      );
61      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA1" );
62
63      RTEMS.TASK_CREATE(
64         SPTEST.TASK_NAME( 2 ),
65         2,
66         2048,
67         RTEMS.DEFAULT_MODES,
68         RTEMS.DEFAULT_ATTRIBUTES,
69         SPTEST.TASK_ID( 2 ),
70         STATUS
71      );
72      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA2" );
73
74      RTEMS.TASK_CREATE(
75         SPTEST.TASK_NAME( 3 ),
76         2,
77         2048,
78         RTEMS.DEFAULT_MODES,
79         RTEMS.DEFAULT_ATTRIBUTES,
80         SPTEST.TASK_ID( 3 ),
81         STATUS
82      );
83      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA3" );
84
85      RTEMS.TASK_CREATE(
86         SPTEST.TASK_NAME( 4 ),
87         2,
88         2048,
89         RTEMS.DEFAULT_MODES,
90         RTEMS.FLOATING_POINT,
91         SPTEST.TASK_ID( 4 ),
92         STATUS
93      );
94      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA4" );
95
96      RTEMS.TASK_CREATE(
97         SPTEST.TASK_NAME( 5 ),
98         2,
99         2048,
100         RTEMS.DEFAULT_MODES,
101         RTEMS.FLOATING_POINT,
102         SPTEST.TASK_ID( 5 ),
103         STATUS
104      );
105      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA5" );
106
107      RTEMS.TASK_CREATE(
108         SPTEST.TASK_NAME( 6 ),
109         1,
110         2048,
111         RTEMS.DEFAULT_MODES,
112         RTEMS.FLOATING_POINT,
113         SPTEST.TASK_ID( 6 ),
114         STATUS
115      );
116      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF FP1" );
117
118      RTEMS.TASK_START(
119         SPTEST.TASK_ID( 6 ),
120         SPTEST.FIRST_FP_TASK'ACCESS,
121         0,
122         STATUS
123      );
124      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF FP1" );
125
126      RTEMS.TASK_START(
127         SPTEST.TASK_ID( 1 ),
128         SPTEST.TASK_1'ACCESS,
129         0,
130         STATUS
131      );
132      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA1" );
133
134      RTEMS.TASK_START(
135         SPTEST.TASK_ID( 2 ),
136         SPTEST.TASK_1'ACCESS,
137         0,
138         STATUS
139      );
140      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA2" );
141
142      RTEMS.TASK_START(
143         SPTEST.TASK_ID( 3 ),
144         SPTEST.TASK_1'ACCESS,
145         0,
146         STATUS
147      );
148      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA3" );
149
150      RTEMS.TASK_START(
151         SPTEST.TASK_ID( 4 ),
152         SPTEST.FP_TASK'ACCESS,
153         0,
154         STATUS
155      );
156      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA4" );
157
158      RTEMS.TASK_START(
159         SPTEST.TASK_ID( 5 ),
160         SPTEST.FP_TASK'ACCESS,
161         0,
162         STATUS
163      );
164      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA5" );
165
166      --
167      --  Load "task dependent factors" in the context areas
168      --
169
170      SPTEST.FP_FACTORS( 0 ) :=    0.0;
171      SPTEST.FP_FACTORS( 1 ) := 1000.1;
172      SPTEST.FP_FACTORS( 2 ) := 2000.2;
173      SPTEST.FP_FACTORS( 3 ) := 3000.3;
174      SPTEST.FP_FACTORS( 4 ) := 4000.4;
175      SPTEST.FP_FACTORS( 5 ) := 5000.5;
176      SPTEST.FP_FACTORS( 6 ) := 6000.6;
177      SPTEST.FP_FACTORS( 7 ) := 7000.7;
178      SPTEST.FP_FACTORS( 8 ) := 8000.8;
179      SPTEST.FP_FACTORS( 9 ) := 9000.9;
180
181      SPTEST.INTEGER_FACTORS( 0 ) := 16#0000#;
182      SPTEST.INTEGER_FACTORS( 1 ) := 16#1000#;
183      SPTEST.INTEGER_FACTORS( 2 ) := 16#2000#;
184      SPTEST.INTEGER_FACTORS( 3 ) := 16#3000#;
185      SPTEST.INTEGER_FACTORS( 4 ) := 16#4000#;
186      SPTEST.INTEGER_FACTORS( 5 ) := 16#5000#;
187      SPTEST.INTEGER_FACTORS( 6 ) := 16#6000#;
188      SPTEST.INTEGER_FACTORS( 7 ) := 16#7000#;
189      SPTEST.INTEGER_FACTORS( 8 ) := 16#8000#;
190      SPTEST.INTEGER_FACTORS( 9 ) := 16#9000#;
191
192      RTEMS.TASK_DELETE( RTEMS.SELF, STATUS );
193      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
194
195   end INIT;
196
197--PAGE
198--
199--  FIRST_FP_TASK
200--
201
202   procedure FIRST_FP_TASK (
203      ARGUMENT : in     RTEMS.TASK_ARGUMENT
204   ) is
205      STATUS     : RTEMS.STATUS_CODES;
206      TID        : RTEMS.ID;
207      TIME       : RTEMS.TIME_OF_DAY;
208      TASK_INDEX : RTEMS.UNSIGNED32;
209      INTEGER_DECLARE;
210      FP_DECLARE;
211   begin
212
213      RTEMS.TASK_IDENT( RTEMS.SELF, RTEMS.SEARCH_ALL_NODES, TID, STATUS );
214      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_IDENT OF SELF" );
215
216      TASK_INDEX := TEST_SUPPORT.TASK_NUMBER( TID );
217   
218      INTEGER_LOAD( INTEGER_FACTORS( TASK_INDEX ) );
219      FP_LOAD( FP_FACTORS( TASK_INDEX ) );
220
221      TEST_SUPPORT.PUT_NAME( SPTEST.TASK_NAME( TASK_INDEX ), FALSE );
222      TEXT_IO.PUT( " - integer base = (" );
223      UNSIGNED32_IO.PUT( INTEGER_FACTORS( TASK_INDEX ), BASE => 16 );
224      TEXT_IO.PUT_LINE( ")" );
225
226      --
227      --  C implementation prints NA if no hardware FP support.
228      --
229
230      TEST_SUPPORT.PUT_NAME(
231         SPTEST.TASK_NAME( TEST_SUPPORT.TASK_NUMBER( TID ) ),
232         FALSE
233      );
234      TEXT_IO.PUT( " - float base = (" );
235      FLOAT_IO.PUT( FP_FACTORS( TASK_INDEX ) );
236      TEXT_IO.PUT_LINE( ")" );
237
238      if ARGUMENT = 0 then
239         RTEMS.TASK_RESTART(
240            RTEMS.SELF,
241            1,
242            STATUS
243         );
244         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_RESTART OF SELF" );
245      else
246         TIME := ( 1988, 12, 31, 9, 0, 0, 0 );
247         RTEMS.CLOCK_SET( TIME, STATUS );
248         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_SET" );
249
250         RTEMS.TASK_DELETE( RTEMS.SELF, STATUS );
251         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
252      end if;
253
254   end FIRST_FP_TASK;
255
256--PAGE
257--
258--  FP_TASK
259--
260
261   procedure FP_TASK (
262      ARGUMENT : in     RTEMS.TASK_ARGUMENT
263   ) is
264      STATUS     : RTEMS.STATUS_CODES;
265      TID        : RTEMS.ID;
266      TIME       : RTEMS.TIME_OF_DAY;
267      TASK_INDEX : RTEMS.UNSIGNED32;
268      INTEGER_DECLARE;
269      FP_DECLARE;
270   begin
271
272      RTEMS.TASK_IDENT( RTEMS.SELF, RTEMS.SEARCH_ALL_NODES, TID, STATUS );
273      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_IDENT OF SELF" );
274   
275      TASK_INDEX := TEST_SUPPORT.TASK_NUMBER( TID );
276 
277      INTEGER_LOAD( INTEGER_FACTORS( TASK_INDEX ) );
278      FP_LOAD( FP_FACTORS( TASK_INDEX ) );
279 
280      TEST_SUPPORT.PUT_NAME(
281         SPTEST.TASK_NAME( TEST_SUPPORT.TASK_NUMBER( TID ) ),
282         FALSE
283      );
284      TEXT_IO.PUT( " - integer base = (" );
285      UNSIGNED32_IO.PUT( INTEGER_FACTORS( TASK_INDEX ), BASE => 16 );
286      TEXT_IO.PUT_LINE( ")" );
287 
288      --
289      --  C implementation prints NA if no hardware FP support.
290      --
291 
292      TEST_SUPPORT.PUT_NAME(
293         SPTEST.TASK_NAME( TEST_SUPPORT.TASK_NUMBER( TID ) ),
294         FALSE
295      );
296      TEXT_IO.PUT( " - float base = (" );
297      FLOAT_IO.PUT( FP_FACTORS( TASK_INDEX ) );
298      TEXT_IO.PUT_LINE( ")" );
299
300      loop
301
302         RTEMS.CLOCK_GET( RTEMS.CLOCK_GET_TOD, TIME'ADDRESS, STATUS );
303         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET" );
304
305         if TIME.SECOND >= 16 then
306
307            if TEST_SUPPORT.TASK_NUMBER( TID ) = 4 then
308               TEXT_IO.PUT_LINE( "TA4 - task_delete - self" );
309               RTEMS.TASK_DELETE( RTEMS.SELF, STATUS );
310               TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA4" );
311            end if;
312     
313            TEXT_IO.PUT_LINE( "TA5 - task_delete - TA3" );
314            RTEMS.TASK_DELETE( SPTEST.TASK_ID( 3 ), STATUS );
315            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA3" );
316 
317            TEXT_IO.PUT_LINE( "*** END OF TEST 19 ***" );
318            RTEMS.SHUTDOWN_EXECUTIVE( 0 );
319         end if;
320
321         TEST_SUPPORT.PUT_NAME(
322            SPTEST.TASK_NAME( TEST_SUPPORT.TASK_NUMBER( TID ) ),
323            FALSE
324         );
325
326         TEST_SUPPORT.PRINT_TIME( " - clock_get - ", TIME, "" );
327         TEXT_IO.NEW_LINE;
328
329         INTEGER_CHECK( INTEGER_FACTORS( TASK_INDEX ) );
330         FP_CHECK( FP_FACTORS( TASK_INDEX ) );
331 
332         RTEMS.TASK_WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
333         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
334         
335      end loop;
336   
337   end FP_TASK;
338
339--PAGE
340--
341--  TASK_1
342--
343
344   procedure TASK_1 (
345      ARGUMENT : in     RTEMS.TASK_ARGUMENT
346   ) is
347      STATUS     : RTEMS.STATUS_CODES;
348      TID        : RTEMS.ID;
349      TIME       : RTEMS.TIME_OF_DAY;
350      TASK_INDEX : RTEMS.UNSIGNED32;
351      INTEGER_DECLARE;
352   begin
353
354      RTEMS.TASK_IDENT( RTEMS.SELF, RTEMS.SEARCH_ALL_NODES, TID, STATUS );
355      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_IDENT OF SELF" );
356   
357      TASK_INDEX := TEST_SUPPORT.TASK_NUMBER( TID );
358 
359      INTEGER_LOAD( INTEGER_FACTORS( TASK_INDEX ) );
360 
361      TEST_SUPPORT.PUT_NAME(
362         SPTEST.TASK_NAME( TEST_SUPPORT.TASK_NUMBER( TID ) ),
363         FALSE
364      );
365      TEXT_IO.PUT( " - integer base = (" );
366      UNSIGNED32_IO.PUT( INTEGER_FACTORS( TASK_INDEX ), BASE => 16 );
367      TEXT_IO.PUT_LINE( ")" );
368 
369      loop
370
371         RTEMS.CLOCK_GET( RTEMS.CLOCK_GET_TOD, TIME'ADDRESS, STATUS );
372         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET" );
373
374         TEST_SUPPORT.PUT_NAME(
375            SPTEST.TASK_NAME( TEST_SUPPORT.TASK_NUMBER( TID ) ),
376            FALSE
377         );
378
379         TEST_SUPPORT.PRINT_TIME( " - clock_get - ", TIME, "" );
380         TEXT_IO.NEW_LINE;
381
382         INTEGER_CHECK( INTEGER_FACTORS( TASK_INDEX ) );
383
384         RTEMS.TASK_WAKE_AFTER(
385            TEST_SUPPORT.TASK_NUMBER( TID ) * 5 *
386              TEST_SUPPORT.TICKS_PER_SECOND,
387            STATUS
388         );
389         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
390         
391      end loop;
392   
393   end TASK_1;
394
395end SPTEST;
Note: See TracBrowser for help on using the repository browser.