source: rtems/c/src/ada-tests/tmtests/tm16/tmtest.adb @ c499856

4.115
Last change on this file since c499856 was c499856, checked in by Chris Johns <chrisj@…>, on 03/20/14 at 21:10:47

Change all references of rtems.com to rtems.org.

  • Property mode set to 100644
File size: 4.4 KB
Line 
1--
2--  TMTEST / BODY
3--
4--  DESCRIPTION:
5--
6--  This package is the implementation of Test 16 of the RTEMS
7--  Timing Test Suite.
8--
9--  DEPENDENCIES:
10--
11-- 
12--
13--  COPYRIGHT (c) 1989-2011.
14--  On-Line Applications Research Corporation (OAR).
15--
16--  The license and distribution terms for this file may in
17--  the file LICENSE in this distribution or at
18--  http://www.rtems.org/license/LICENSE.
19--
20
21with INTERFACES; use INTERFACES;
22with RTEMS_CALLING_OVERHEAD;
23with TEST_SUPPORT;
24with TEXT_IO;
25with TIMER_DRIVER;
26with RTEMS.EVENT;
27
28package body TMTEST is
29
30--
31--  INIT
32--
33
34   procedure INIT (
35      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
36   ) is
37      pragma Unreferenced(ARGUMENT);
38      ID     : RTEMS.ID;
39      STATUS : RTEMS.STATUS_CODES;
40   begin
41
42      TEXT_IO.NEW_LINE( 2 );
43      TEXT_IO.PUT_LINE( "*** TIME TEST 16 ***" );
44
45      RTEMS.TASKS.CREATE(
46         RTEMS.BUILD_NAME( 'T', 'E', 'S', 'T' ),
47         251,
48         2048,
49         RTEMS.DEFAULT_MODES,
50         RTEMS.DEFAULT_ATTRIBUTES,
51         ID,
52         STATUS
53      );
54      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TEST INIT" );
55
56      RTEMS.TASKS.START(
57         ID,
58         TMTEST.TEST_INIT'ACCESS,
59         0,
60         STATUS
61      );
62      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TEST INIT" );
63
64      RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
65      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
66
67   end INIT;
68
69--
70--  TEST_INIT
71--
72
73   procedure TEST_INIT (
74      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
75   ) is
76      pragma Unreferenced(ARGUMENT);
77      PRIORITY   : RTEMS.TASKS.PRIORITY;
78      TASK_ENTRY : RTEMS.TASKS.ENTRY_POINT;
79      STATUS     : RTEMS.STATUS_CODES;
80   begin
81
82      PRIORITY := 250;
83
84      for INDEX in 0 .. TIME_TEST_SUPPORT.OPERATION_COUNT
85      loop
86
87         RTEMS.TASKS.CREATE(
88            RTEMS.BUILD_NAME( 'M', 'I', 'D', ' ' ),
89            PRIORITY,
90            1024,
91            RTEMS.DEFAULT_MODES,
92            RTEMS.DEFAULT_ATTRIBUTES,
93            TMTEST.TASK_ID( INDEX ),
94            STATUS
95         );
96         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE LOOP" );
97
98         if INDEX = TIME_TEST_SUPPORT.OPERATION_COUNT then
99            TASK_ENTRY := TMTEST.HIGH_TASK'ACCESS;
100         else
101            TASK_ENTRY := TMTEST.MIDDLE_TASKS'ACCESS;
102         end if;
103
104         RTEMS.TASKS.START(
105            TMTEST.TASK_ID( INDEX ),
106            TASK_ENTRY,
107            0,
108            STATUS
109         );
110         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START LOOP" );
111
112         PRIORITY := PRIORITY - 1;
113
114      end loop;
115
116      TMTEST.TASK_COUNT := 0;
117
118      TIMER_DRIVER.INITIALIZE;                  -- starts the timer
119
120      RTEMS.EVENT.SEND(                         -- preempts task
121         TMTEST.TASK_ID( TMTEST.TASK_COUNT ),
122         RTEMS.EVENT_16,
123         STATUS
124      );
125      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND" );
126     
127   end TEST_INIT;
128
129--
130--  MIDDLE_TASKS
131--
132
133   procedure MIDDLE_TASKS (
134      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
135   ) is
136      pragma Unreferenced(ARGUMENT);
137      EVENT_OUT : RTEMS.EVENT_SET;
138      STATUS    : RTEMS.STATUS_CODES;
139   begin
140
141      RTEMS.EVENT.RECEIVE(                      -- task blocks
142         RTEMS.EVENT_16,
143         RTEMS.DEFAULT_OPTIONS,
144         RTEMS.NO_TIMEOUT,
145         EVENT_OUT,
146         STATUS
147      );
148      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE" );
149
150      TMTEST.TASK_COUNT := TMTEST.TASK_COUNT + 1;
151
152      RTEMS.EVENT.SEND(                         -- preempts task
153         TMTEST.TASK_ID( TMTEST.TASK_COUNT ),
154         RTEMS.EVENT_16,
155         STATUS
156      );
157      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND" );
158     
159   end MIDDLE_TASKS;
160
161--
162--  HIGH_TASK
163--
164
165   procedure HIGH_TASK (
166      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
167   ) is
168      pragma Unreferenced(ARGUMENT);
169      EVENT_OUT : RTEMS.EVENT_SET;
170      STATUS    : RTEMS.STATUS_CODES;
171   begin
172
173      RTEMS.EVENT.RECEIVE(                      -- task blocks
174         RTEMS.EVENT_16,
175         RTEMS.DEFAULT_OPTIONS,
176         RTEMS.NO_TIMEOUT,
177         EVENT_OUT,
178         STATUS
179      );
180
181      TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
182
183      TIME_TEST_SUPPORT.PUT_TIME(
184         "EVENT_SEND (preemptive)",
185         TMTEST.END_TIME,
186         TIME_TEST_SUPPORT.OPERATION_COUNT,
187         0,
188         RTEMS_CALLING_OVERHEAD.EVENT_SEND
189      );
190
191      TEXT_IO.PUT_LINE( "*** END OF TIME TEST 16 ***" );
192      RTEMS.SHUTDOWN_EXECUTIVE( 0 );
193
194   end HIGH_TASK;
195
196end TMTEST;
Note: See TracBrowser for help on using the repository browser.