Warning, /testsuites/ada/tmtests/tm12/tmtest.adb is written in an unsupported language. File is not indexed.
0001 -- SPDX-License-Identifier: BSD-2-Clause
0002
0003 --
0004 -- TMTEST / BODY
0005 --
0006 -- DESCRIPTION:
0007 --
0008 -- This package is the implementation of Test 12 of the RTEMS
0009 -- Timing Test Suite.
0010 --
0011 -- DEPENDENCIES:
0012 --
0013 --
0014 --
0015 -- COPYRIGHT (c) 1989-2011.
0016 -- On-Line Applications Research Corporation (OAR).
0017 --
0018 -- Redistribution and use in source and binary forms, with or without
0019 -- modification, are permitted provided that the following conditions
0020 -- are met:
0021 -- 1. Redistributions of source code must retain the above copyright
0022 -- notice, this list of conditions and the following disclaimer.
0023 -- 2. Redistributions in binary form must reproduce the above copyright
0024 -- notice, this list of conditions and the following disclaimer in the
0025 -- documentation and/or other materials provided with the distribution.
0026 --
0027 -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
0028 -- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
0029 -- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
0030 -- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
0031 -- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
0032 -- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
0033 -- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
0034 -- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
0035 -- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
0036 -- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
0037 -- POSSIBILITY OF SUCH DAMAGE.
0038 --
0039
0040 with INTERFACES; use INTERFACES;
0041 with RTEMS_CALLING_OVERHEAD;
0042 with TEST_SUPPORT;
0043 with TEXT_IO;
0044 with TIME_TEST_SUPPORT;
0045 with TIMER_DRIVER;
0046 with RTEMS.MESSAGE_QUEUE;
0047
0048 package body TMTEST is
0049
0050 --
0051 -- INIT
0052 --
0053
0054 procedure INIT (
0055 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0056 ) is
0057 pragma Unreferenced(ARGUMENT);
0058 TASK_ID : RTEMS.ID;
0059 STATUS : RTEMS.STATUS_CODES;
0060 begin
0061
0062 TEXT_IO.NEW_LINE( 2 );
0063 TEST_SUPPORT.ADA_TEST_BEGIN;
0064
0065 RTEMS.TASKS.CREATE(
0066 1,
0067 251,
0068 1024,
0069 RTEMS.DEFAULT_MODES,
0070 RTEMS.DEFAULT_ATTRIBUTES,
0071 TASK_ID,
0072 STATUS
0073 );
0074 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
0075
0076 RTEMS.TASKS.START(
0077 TASK_ID,
0078 TMTEST.TEST_INIT'ACCESS,
0079 0,
0080 STATUS
0081 );
0082 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
0083
0084 RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0085 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
0086
0087 end INIT;
0088
0089 --
0090 -- TEST_INIT
0091 --
0092
0093 procedure TEST_INIT (
0094 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0095 ) is
0096 pragma Unreferenced(ARGUMENT);
0097 TASK_ENTRY : RTEMS.TASKS.ENTRY_POINT;
0098 PRIORITY : RTEMS.TASKS.PRIORITY;
0099 TASK_ID : RTEMS.ID;
0100 STATUS : RTEMS.STATUS_CODES;
0101 begin
0102
0103 RTEMS.MESSAGE_QUEUE.CREATE(
0104 RTEMS.BUILD_NAME( 'M', 'Q', '1', ' ' ),
0105 TIME_TEST_SUPPORT.OPERATION_COUNT,
0106 16,
0107 RTEMS.DEFAULT_OPTIONS,
0108 TMTEST.QUEUE_ID,
0109 STATUS
0110 );
0111 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_CREATE" );
0112
0113 PRIORITY := 250;
0114
0115 for INDEX in 0 .. TIME_TEST_SUPPORT.OPERATION_COUNT - 1
0116 loop
0117
0118 RTEMS.TASKS.CREATE(
0119 RTEMS.BUILD_NAME( 'T', 'I', 'M', 'E' ),
0120 PRIORITY,
0121 1024,
0122 RTEMS.DEFAULT_MODES,
0123 RTEMS.DEFAULT_ATTRIBUTES,
0124 TASK_ID,
0125 STATUS
0126 );
0127 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE LOOP" );
0128
0129 PRIORITY := PRIORITY - 1;
0130
0131 if INDEX = TIME_TEST_SUPPORT.OPERATION_COUNT - 1 then
0132 TASK_ENTRY := TMTEST.HIGH_TASK'ACCESS;
0133 else
0134 TASK_ENTRY := TMTEST.LOW_TASKS'ACCESS;
0135 end if;
0136
0137 RTEMS.TASKS.START( TASK_ID, TASK_ENTRY, 0, STATUS );
0138 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START LOOP" );
0139
0140 end loop;
0141
0142 end TEST_INIT;
0143
0144 --
0145 -- HIGH_TASK
0146 --
0147
0148 procedure HIGH_TASK (
0149 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0150 ) is
0151 pragma Unreferenced(ARGUMENT);
0152 BUFFER : TMTEST.BUFFER;
0153 BUFFER_POINTER : RTEMS.ADDRESS;
0154 OVERHEAD : RTEMS.UNSIGNED32;
0155 STATUS : RTEMS.STATUS_CODES;
0156 begin
0157
0158 BUFFER_POINTER := BUFFER'ADDRESS;
0159
0160 TIMER_DRIVER.INITIALIZE;
0161 for INDEX in 1 .. TIME_TEST_SUPPORT.OPERATION_COUNT
0162 loop
0163 TIMER_DRIVER.EMPTY_FUNCTION;
0164 end loop;
0165 OVERHEAD := TIMER_DRIVER.READ_TIMER;
0166
0167 for INDEX in 1 .. TIME_TEST_SUPPORT.OPERATION_COUNT
0168 loop
0169
0170 RTEMS.MESSAGE_QUEUE.SEND(
0171 TMTEST.QUEUE_ID,
0172 BUFFER_POINTER,
0173 16,
0174 STATUS
0175 );
0176 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_SEND" ); --XXX
0177
0178 end loop;
0179
0180 TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0181
0182 TIME_TEST_SUPPORT.PUT_TIME(
0183 "MESSAGE_QUEUE_SEND (readying)",
0184 TMTEST.END_TIME,
0185 TIME_TEST_SUPPORT.OPERATION_COUNT,
0186 OVERHEAD,
0187 RTEMS_CALLING_OVERHEAD.MESSAGE_QUEUE_SEND
0188 );
0189
0190 TEST_SUPPORT.ADA_TEST_END;
0191 RTEMS.SHUTDOWN_EXECUTIVE( 0 );
0192
0193 end HIGH_TASK;
0194
0195 --
0196 -- LOW_TASK
0197 --
0198
0199 procedure LOW_TASKS (
0200 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0201 ) is
0202 pragma Unreferenced(ARGUMENT);
0203 BUFFER : TMTEST.BUFFER;
0204 BUFFER_POINTER : RTEMS.ADDRESS;
0205 MESSAGE_SIZE : RTEMS.Size := 0;
0206 STATUS : RTEMS.STATUS_CODES;
0207 begin
0208
0209 BUFFER_POINTER := BUFFER'ADDRESS;
0210
0211 RTEMS.MESSAGE_QUEUE.RECEIVE(
0212 TMTEST.QUEUE_ID,
0213 BUFFER_POINTER,
0214 RTEMS.DEFAULT_OPTIONS,
0215 RTEMS.NO_TIMEOUT,
0216 MESSAGE_SIZE,
0217 STATUS
0218 );
0219 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_RECEIVE" ); --XXX
0220
0221 end LOW_TASKS;
0222
0223 end TMTEST;
