source: rtems/c/src/ada-tests/mptests/mp07/mptest.adb @ 2b7fc9cc

4.104.114.84.95
Last change on this file since 2b7fc9cc was bf9ae83, checked in by Joel Sherrill <joel.sherrill@…>, on 06/02/97 at 20:32:11

modified copyright notice to be the same as RTEMS 4.0.0.

changed the CVS ID string to be a "development" version.

  • Property mode set to 100644
File size: 4.9 KB
Line 
1--
2--  MPTEST / BODY
3--
4--  DESCRIPTION:
5--
6--  This package is the implementation for Test 7 of the RTEMS
7--  Multiprocessor Test Suite.
8--
9--  DEPENDENCIES:
10--
11-- 
12--
13--  COPYRIGHT (c) 1989-1997.
14--  On-Line Applications Research Corporation (OAR).
15--  Copyright assigned to U.S. Government, 1994.
16--
17--  The license and distribution terms for this file may in
18--  the file LICENSE in this distribution or at
19--  http://www.OARcorp.com/rtems/license.html.
20--
21--  $Id$
22--
23
24with INTERFACES; use INTERFACES;
25with RTEMS;
26with TEST_SUPPORT;
27with TEXT_IO;
28with UNSIGNED32_IO;
29
30package body MPTEST is
31
32   package body PER_NODE_CONFIGURATION is separate;
33
34--PAGE
35--
36--  INIT
37--
38
39   procedure INIT (
40      ARGUMENT : in     RTEMS.TASK_ARGUMENT
41   ) is
42      STATUS : RTEMS.STATUS_CODES;
43   begin
44
45      TEXT_IO.NEW_LINE( 2 );
46      TEXT_IO.PUT( "*** TEST 7 -- NODE " );
47      UNSIGNED32_IO.PUT(
48         MPTEST.MULTIPROCESSING_CONFIGURATION.NODE,
49         WIDTH => 1
50      );
51      TEXT_IO.PUT_LINE( " ***" );
52
53      MPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME(  '1', '1', '1', ' ' );
54      MPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME(  '2', '2', '2', ' ' );
55
56      TEXT_IO.PUT_LINE( "Creating Test_task (Global)" );
57      RTEMS.TASK_CREATE(
58         MPTEST.TASK_NAME( MPTEST.MULTIPROCESSING_CONFIGURATION.NODE ),
59         MPTEST.MULTIPROCESSING_CONFIGURATION.NODE,
60         2048,
61         RTEMS.TIMESLICE,
62         RTEMS.GLOBAL,
63         MPTEST.TASK_ID( 1 ),
64         STATUS
65      );
66      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
67
68      TEXT_IO.PUT_LINE( "Starting Test_task (Global)" );
69      RTEMS.TASK_START(
70         MPTEST.TASK_ID( 1 ),
71         MPTEST.TEST_TASK'ACCESS,
72         0,
73         STATUS
74      );
75      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
76
77      MPTEST.TIMER_NAME( 1 ) := RTEMS.BUILD_NAME(  'T', 'M', '1', ' ' );
78
79      RTEMS.TIMER_CREATE(
80         MPTEST.TIMER_NAME( 1 ),
81         MPTEST.TIMER_ID( 1 ),
82         STATUS
83      );
84      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE" );
85
86      TEXT_IO.PUT_LINE( "Deleting initialization task" );
87      RTEMS.TASK_DELETE( RTEMS.SELF, STATUS );
88      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
89
90   end INIT;
91
92--PAGE
93--
94--  STOP_TEST_TSR
95--
96 
97   procedure STOP_TEST_TSR (
98      IGNORED1 : in     RTEMS.ID;
99      IGNORED2 : in     RTEMS.ADDRESS
100   ) is
101   begin
102 
103      MPTEST.STOP_TEST := TRUE;
104 
105   end STOP_TEST_TSR;
106 
107--PAGE
108--
109--  TEST_TASK
110--
111
112   procedure TEST_TASK (
113      ARGUMENT : in     RTEMS.TASK_ARGUMENT
114   ) is
115      COUNT     : RTEMS.UNSIGNED32;
116      EVENT_OUT : RTEMS.EVENT_SET;
117      STATUS    : RTEMS.STATUS_CODES;
118   begin
119
120      MPTEST.STOP_TEST := FALSE;
121
122      if MPTEST.MULTIPROCESSING_CONFIGURATION.NODE = 1 then
123         MPTEST.REMOTE_NODE := 2;
124      else
125         MPTEST.REMOTE_NODE := 1;
126      end if;
127
128      TEXT_IO.PUT( "Remote task's name is : " );
129      TEST_SUPPORT.PUT_NAME( MPTEST.TASK_NAME( MPTEST.REMOTE_NODE ), TRUE );
130
131      TEXT_IO.PUT_LINE( "Getting TID of remote task" );
132      loop
133         RTEMS.TASK_IDENT(
134            MPTEST.TASK_NAME( MPTEST.REMOTE_NODE ),
135            RTEMS.SEARCH_ALL_NODES,
136            MPTEST.REMOTE_TID,
137            STATUS
138         );
139
140         exit when RTEMS.ARE_STATUSES_EQUAL( STATUS, RTEMS.SUCCESSFUL );
141
142      end loop;
143
144      if MPTEST.MULTIPROCESSING_CONFIGURATION.NODE = 1 then
145
146         TEXT_IO.PUT_LINE( "Sending first event to remote task" );
147         RTEMS.EVENT_SEND(
148            MPTEST.REMOTE_TID,
149            RTEMS.EVENT_16,
150            STATUS
151         );
152         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND" );
153
154      end if;
155
156      RTEMS.TIMER_FIRE_AFTER(
157         MPTEST.TIMER_ID( 1 ),
158         5 * TEST_SUPPORT.TICKS_PER_SECOND,
159         MPTEST.STOP_TEST_TSR'ACCESS,
160         RTEMS.NULL_ADDRESS,
161         STATUS
162      );
163      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER" );
164
165      loop
166
167         exit when MPTEST.STOP_TEST = TRUE;
168
169         for COUNT in 1 .. MPTEST.PER_DOT
170         loop
171
172            RTEMS.EVENT_RECEIVE(
173               RTEMS.EVENT_16,
174               RTEMS.DEFAULT_OPTIONS,
175               TEST_SUPPORT.TICKS_PER_SECOND,
176               EVENT_OUT,
177               STATUS
178            );
179            if RTEMS.ARE_STATUSES_EQUAL( STATUS, RTEMS.TIMEOUT ) then
180               TEXT_IO.NEW_LINE;
181               TEXT_IO.PUT_LINE(
182                   "TA1 - TIMEOUT .. probably OK if the other node exits"
183               );
184               exit;
185            else
186               TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE" );
187            end if;
188
189            RTEMS.EVENT_SEND(
190               MPTEST.REMOTE_TID,
191               RTEMS.EVENT_16,
192               STATUS
193            );
194            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND" );
195
196         end loop;
197
198         TEST_SUPPORT.PUT_DOT( "." );
199
200      end loop;
201
202      TEXT_IO.NEW_LINE;
203
204      TEXT_IO.PUT_LINE( "*** END OF TEST 7 ***" );
205
206      RTEMS.SHUTDOWN_EXECUTIVE( 0 );
207
208   end TEST_TASK;
209
210end MPTEST;
Note: See TracBrowser for help on using the repository browser.