Warning, /testsuites/ada/tmtests/tm22/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 22 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 RTEMS_CALLING_OVERHEAD;
0041 with TEST_SUPPORT;
0042 with TEXT_IO;
0043 with TIME_TEST_SUPPORT;
0044 with TIMER_DRIVER;
0045 with RTEMS.MESSAGE_QUEUE;
0046
0047 package body TMTEST is
0048
0049 --
0050 -- INIT
0051 --
0052
0053 procedure INIT (
0054 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0055 ) is
0056 pragma Unreferenced(ARGUMENT);
0057 ID : RTEMS.ID;
0058 STATUS : RTEMS.STATUS_CODES;
0059 begin
0060
0061 TEXT_IO.NEW_LINE( 2 );
0062 TEST_SUPPORT.ADA_TEST_BEGIN;
0063
0064 RTEMS.MESSAGE_QUEUE.CREATE(
0065 RTEMS.BUILD_NAME( 'M', 'Q', '1', ' ' ),
0066 100,
0067 16,
0068 RTEMS.DEFAULT_ATTRIBUTES,
0069 TMTEST.MESSAGE_QUEUE_ID,
0070 STATUS
0071 );
0072 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_CREATE" );
0073
0074 RTEMS.TASKS.CREATE(
0075 RTEMS.BUILD_NAME( 'L', 'O', 'W', ' ' ),
0076 10,
0077 2048,
0078 RTEMS.NO_PREEMPT,
0079 RTEMS.DEFAULT_ATTRIBUTES,
0080 ID,
0081 STATUS
0082 );
0083 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE LOW" );
0084
0085 RTEMS.TASKS.START( ID, TMTEST.LOW_TASK'ACCESS, 0, STATUS );
0086 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START LOW" );
0087
0088 RTEMS.TASKS.CREATE(
0089 RTEMS.BUILD_NAME( 'P', 'R', 'M', 'T' ),
0090 11,
0091 2048,
0092 RTEMS.DEFAULT_MODES,
0093 RTEMS.DEFAULT_ATTRIBUTES,
0094 ID,
0095 STATUS
0096 );
0097 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE PREEMPT" );
0098
0099 RTEMS.TASKS.START( ID, TMTEST.PREEMPT_TASK'ACCESS, 0, STATUS );
0100 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START PREEMPT" );
0101
0102 RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0103 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
0104
0105 end INIT;
0106
0107 --
0108 -- HIGH_TASK
0109 --
0110
0111 procedure HIGH_TASK (
0112 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0113 ) is
0114 pragma Unreferenced(ARGUMENT);
0115 BUFFER : TMTEST.BUFFER;
0116 BUFFER_POINTER : RTEMS.ADDRESS;
0117 COUNT : RTEMS.UNSIGNED32;
0118 STATUS : RTEMS.STATUS_CODES;
0119 begin
0120
0121 BUFFER_POINTER := BUFFER'ADDRESS;
0122
0123 TIMER_DRIVER.INITIALIZE;
0124 RTEMS.MESSAGE_QUEUE.BROADCAST(
0125 TMTEST.MESSAGE_QUEUE_ID,
0126 BUFFER_POINTER,
0127 16,
0128 COUNT,
0129 STATUS
0130 );
0131 TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0132
0133 TIME_TEST_SUPPORT.PUT_TIME(
0134 "MESSAGE_QUEUE_BROADCAST (readying)",
0135 TMTEST.END_TIME,
0136 1,
0137 0,
0138 RTEMS_CALLING_OVERHEAD.MESSAGE_QUEUE_BROADCAST
0139 );
0140
0141 RTEMS.TASKS.SUSPEND( RTEMS.SELF, STATUS );
0142 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );
0143
0144 end HIGH_TASK;
0145
0146 --
0147 -- LOW_TASK
0148 --
0149
0150 procedure LOW_TASK (
0151 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0152 ) is
0153 pragma Unreferenced(ARGUMENT);
0154 ID : RTEMS.ID;
0155 BUFFER : TMTEST.BUFFER;
0156 BUFFER_POINTER : RTEMS.ADDRESS;
0157 OVERHEAD : RTEMS.UNSIGNED32;
0158 COUNT : RTEMS.UNSIGNED32;
0159 MESSAGE_SIZE : RTEMS.Size := 0;
0160 STATUS : RTEMS.STATUS_CODES;
0161 begin
0162
0163 BUFFER_POINTER := BUFFER'ADDRESS;
0164
0165 RTEMS.TASKS.CREATE(
0166 RTEMS.BUILD_NAME( 'H', 'I', 'G', 'H' ),
0167 5,
0168 2048,
0169 RTEMS.NO_PREEMPT,
0170 RTEMS.DEFAULT_ATTRIBUTES,
0171 ID,
0172 STATUS
0173 );
0174 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE HIGH" );
0175
0176 RTEMS.TASKS.START( ID, TMTEST.HIGH_TASK'ACCESS, 0, STATUS );
0177 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START HIGH" );
0178
0179 RTEMS.MESSAGE_QUEUE.RECEIVE(
0180 TMTEST.MESSAGE_QUEUE_ID,
0181 BUFFER_POINTER,
0182 RTEMS.DEFAULT_MODES,
0183 RTEMS.NO_TIMEOUT,
0184 MESSAGE_SIZE,
0185 STATUS
0186 );
0187
0188 TIMER_DRIVER.INITIALIZE;
0189 for INDEX in 1 .. TIME_TEST_SUPPORT.OPERATION_COUNT
0190 loop
0191 TIMER_DRIVER.EMPTY_FUNCTION;
0192 end loop;
0193 OVERHEAD := TIMER_DRIVER.READ_TIMER;
0194
0195 TIMER_DRIVER.INITIALIZE;
0196 for INDEX in 1 .. TIME_TEST_SUPPORT.OPERATION_COUNT
0197 loop
0198 RTEMS.MESSAGE_QUEUE.BROADCAST(
0199 TMTEST.MESSAGE_QUEUE_ID,
0200 BUFFER_POINTER,
0201 16,
0202 COUNT,
0203 STATUS
0204 );
0205 end loop;
0206 TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0207
0208 TIME_TEST_SUPPORT.PUT_TIME(
0209 "MESSAGE_QUEUE_BROADCAST (no waiting tasks)",
0210 TMTEST.END_TIME,
0211 TIME_TEST_SUPPORT.OPERATION_COUNT,
0212 OVERHEAD,
0213 RTEMS_CALLING_OVERHEAD.MESSAGE_QUEUE_BROADCAST
0214 );
0215
0216 RTEMS.MESSAGE_QUEUE.RECEIVE(
0217 TMTEST.MESSAGE_QUEUE_ID,
0218 BUFFER_POINTER,
0219 RTEMS.DEFAULT_MODES,
0220 RTEMS.NO_TIMEOUT,
0221 MESSAGE_SIZE,
0222 STATUS
0223 );
0224
0225 -- should go to PREEMPT_TASK here
0226
0227 TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0228
0229 TIME_TEST_SUPPORT.PUT_TIME(
0230 "MESSAGE_QUEUE_BROADCAST (preempt)",
0231 TMTEST.END_TIME,
0232 1,
0233 0,
0234 RTEMS_CALLING_OVERHEAD.MESSAGE_QUEUE_BROADCAST
0235 );
0236
0237 TEST_SUPPORT.ADA_TEST_END;
0238 RTEMS.SHUTDOWN_EXECUTIVE( 0 );
0239
0240 end LOW_TASK;
0241
0242 --
0243 -- LOW_TASK
0244 --
0245
0246 procedure PREEMPT_TASK (
0247 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0248 ) is
0249 pragma Unreferenced(ARGUMENT);
0250 BUFFER : TMTEST.BUFFER;
0251 BUFFER_POINTER : RTEMS.ADDRESS;
0252 COUNT : RTEMS.UNSIGNED32;
0253 STATUS : RTEMS.STATUS_CODES;
0254 begin
0255
0256 BUFFER_POINTER := BUFFER'ADDRESS;
0257
0258 TIMER_DRIVER.INITIALIZE;
0259 RTEMS.MESSAGE_QUEUE.BROADCAST(
0260 TMTEST.MESSAGE_QUEUE_ID,
0261 BUFFER_POINTER,
0262 16,
0263 COUNT,
0264 STATUS
0265 );
0266
0267 -- should be preempted by LOW_TASK
0268
0269 end PREEMPT_TASK;
0270
0271 end TMTEST;
