source: rtems/c/src/ada-tests/tmtests/tm12/tmtest.adb @ 3b1a322

4.9
Last change on this file since 3b1a322 was 3b1a322, checked in by Joel Sherrill <joel.sherrill@…>, on 09/29/08 at 20:44:38

2008-09-29 Joel Sherrill <joel.sherrill@…>

  • support/timer_driver.adb, support/timer_driver.ads, tmtests/tm01/tmtest.adb, tmtests/tm02/tmtest.adb, tmtests/tm03/tmtest.adb, tmtests/tm04/tmtest.adb, tmtests/tm05/tmtest.adb, tmtests/tm06/tmtest.adb, tmtests/tm07/tmtest.adb, tmtests/tm08/tmtest.adb, tmtests/tm09/tmtest.adb, tmtests/tm10/tmtest.adb, tmtests/tm11/tmtest.adb, tmtests/tm12/tmtest.adb, tmtests/tm13/tmtest.adb, tmtests/tm14/tmtest.adb, tmtests/tm15/tmtest.adb, tmtests/tm16/tmtest.adb, tmtests/tm17/tmtest.adb, tmtests/tm18/tmtest.adb, tmtests/tm19/tmtest.adb, tmtests/tm20/config.h, tmtests/tm20/tmtest.adb, tmtests/tm21/tmtest.adb, tmtests/tm22/tmtest.adb, tmtests/tm23/tmtest.adb, tmtests/tm24/tmtest.adb, tmtests/tm25/tmtest.adb, tmtests/tm28/tmtest.adb, tmtests/tm29/tmtest.adb, tmtests/tmck/tmtest.adb, tmtests/tmoverhd/tmtest.adb: Clean up. Verified to run on psim with gcc 4.3.2.
  • Property mode set to 100644
File size: 4.6 KB
Line 
1--
2--  TMTEST / BODY
3--
4--  DESCRIPTION:
5--
6--  This package is the implementation of Test 12 of the RTEMS
7--  Timing Test Suite.
8--
9--  DEPENDENCIES:
10--
11-- 
12--
13--  COPYRIGHT (c) 1989-1997.
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.com/license/LICENSE.
19--
20--  $Id$
21--
22
23with INTERFACES; use INTERFACES;
24with RTEMS;
25with RTEMS_CALLING_OVERHEAD;
26with TEST_SUPPORT;
27with TEXT_IO;
28with TIME_TEST_SUPPORT;
29with UNSIGNED32_IO;
30
31package body TMTEST is
32
33--PAGE
34--
35--  INIT
36--
37
38   procedure INIT (
39      ARGUMENT : in     RTEMS.TASK_ARGUMENT
40   ) is
41      TASK_ID : RTEMS.ID;
42      STATUS  : RTEMS.STATUS_CODES;
43   begin
44
45      TEXT_IO.NEW_LINE( 2 );
46      TEXT_IO.PUT_LINE( "*** TIME TEST 12 ***" );
47
48      RTEMS.TASK_CREATE(
49         1,
50         251,
51         1024,
52         RTEMS.DEFAULT_MODES,
53         RTEMS.DEFAULT_ATTRIBUTES,
54         TASK_ID,
55         STATUS
56      );
57      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
58
59      RTEMS.TASK_START(
60         TASK_ID,
61         TMTEST.TEST_INIT'ACCESS,
62         0,
63         STATUS
64      );
65      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
66
67      RTEMS.TASK_DELETE( RTEMS.SELF, STATUS );
68      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
69
70   end INIT;
71
72--PAGE
73--
74--  TEST_INIT
75--
76
77   procedure TEST_INIT (
78      ARGUMENT : in     RTEMS.TASK_ARGUMENT
79   ) is
80      TASK_ENTRY     : RTEMS.TASK_ENTRY;
81      PRIORITY       : RTEMS.TASK_PRIORITY;
82      TASK_ID        : RTEMS.ID;
83      BUFFER         : TMTEST.BUFFER;
84      BUFFER_POINTER : RTEMS.ADDRESS;
85      STATUS         : RTEMS.STATUS_CODES;
86   begin
87
88      BUFFER_POINTER := BUFFER'ADDRESS;
89
90      RTEMS.MESSAGE_QUEUE_CREATE(
91         RTEMS.BUILD_NAME( 'M', 'Q', '1', ' ' ),
92         TIME_TEST_SUPPORT.OPERATION_COUNT,
93         16,
94         RTEMS.DEFAULT_OPTIONS,
95         TMTEST.QUEUE_ID,
96         STATUS
97      );
98      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_CREATE" );
99
100      PRIORITY := 250;
101
102      for INDEX in 0 .. TIME_TEST_SUPPORT.OPERATION_COUNT - 1
103      loop
104
105         RTEMS.TASK_CREATE(
106            RTEMS.BUILD_NAME( 'T', 'I', 'M', 'E' ),
107            PRIORITY,
108            1024,
109            RTEMS.DEFAULT_MODES,
110            RTEMS.DEFAULT_ATTRIBUTES,
111            TASK_ID,
112            STATUS
113         );
114         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE LOOP" );
115
116         PRIORITY := PRIORITY - 1;
117
118         if INDEX = TIME_TEST_SUPPORT.OPERATION_COUNT - 1 then
119            TASK_ENTRY := TMTEST.HIGH_TASK'ACCESS;
120         else
121            TASK_ENTRY := TMTEST.LOW_TASKS'ACCESS;
122         end if;
123
124         RTEMS.TASK_START( TASK_ID, TASK_ENTRY, 0, STATUS );
125         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START LOOP" );
126
127      end loop;
128
129   end TEST_INIT;
130
131--PAGE
132--
133--  HIGH_TASK
134--
135
136   procedure HIGH_TASK (
137      ARGUMENT : in     RTEMS.TASK_ARGUMENT
138   ) is
139      BUFFER         : TMTEST.BUFFER;
140      BUFFER_POINTER : RTEMS.ADDRESS;
141      OVERHEAD       : RTEMS.UNSIGNED32;
142      STATUS         : RTEMS.STATUS_CODES;
143   begin
144
145      BUFFER_POINTER := BUFFER'ADDRESS;
146
147      TIMER_DRIVER.INITIALIZE;
148         for INDEX in 1 .. TIME_TEST_SUPPORT.OPERATION_COUNT
149         loop
150            TIMER_DRIVER.EMPTY_FUNCTION;
151         end loop;
152      OVERHEAD := TIMER_DRIVER.READ_TIMER;
153
154      for INDEX in 1 .. TIME_TEST_SUPPORT.OPERATION_COUNT
155      loop
156     
157         RTEMS.MESSAGE_QUEUE_SEND(
158            TMTEST.QUEUE_ID,
159            BUFFER_POINTER,
160            16,
161            STATUS
162         );
163         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_SEND" ); --XXX
164
165      end loop;
166
167      TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
168
169      TIME_TEST_SUPPORT.PUT_TIME(
170         "MESSAGE_QUEUE_SEND (readying)",
171         TMTEST.END_TIME,
172         TIME_TEST_SUPPORT.OPERATION_COUNT,
173         OVERHEAD,
174         RTEMS_CALLING_OVERHEAD.MESSAGE_QUEUE_SEND
175      );
176
177      TEXT_IO.PUT_LINE( "*** END OF TIME TEST 12 ***" );
178      RTEMS.SHUTDOWN_EXECUTIVE( 0 );
179
180   end HIGH_TASK;
181
182--PAGE
183--
184--  LOW_TASK
185--
186
187   procedure LOW_TASKS (
188      ARGUMENT : in     RTEMS.TASK_ARGUMENT
189   ) is
190      BUFFER         : TMTEST.BUFFER;
191      BUFFER_POINTER : RTEMS.ADDRESS;
192      MESSAGE_SIZE   : RTEMS.UNSIGNED32;
193      STATUS         : RTEMS.STATUS_CODES;
194   begin
195 
196      BUFFER_POINTER := BUFFER'ADDRESS;
197
198      RTEMS.MESSAGE_QUEUE_RECEIVE(
199         TMTEST.QUEUE_ID,
200         BUFFER_POINTER,
201         RTEMS.DEFAULT_OPTIONS,
202         RTEMS.NO_TIMEOUT,
203         MESSAGE_SIZE,
204         STATUS
205      );
206      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_RECEIVE" ); --XXX
207 
208   end LOW_TASKS;
209
210end TMTEST;
Note: See TracBrowser for help on using the repository browser.