--::::::::::
--sritests.pro
--::::::::::
-------- SIMTEL20 Ada Software Repository Prologue ------------
--
-- Unit name : SRITESTS
-- Version : 1
-- Author : SRI
-- DDN Address :
-- Copyright :
-- Date created :
-- Release date : 7/11/87
-- Last update : 7/11/87
-- Machine/System Compiled/Run on : VAX/VMS
--
---------------------------------------------------------------
--
-- Keywords : benchmarks, tasking
--
-- Abstract :
-- SRITESTS contains a set of Ada compiler tests/benchmarks which
-- concentrate on Ada tasking.
------------------ Revision history ---------------------------
--
-- DATE VERSION AUTHOR HISTORY
-- 7/11/87 1 SRI First ASR Release
------------------ Distribution and Copyright -----------------
--
-- This prologue must be included in all copies of this software.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
-- software released to the Public Domain is not subject
-- to copyright protection).
-- Restrictions on use or distribution: NONE
--
------------------ Disclaimer ---------------------------------
--
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered. The user is advised to
-- test the software thoroughly before relying on it. The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--
-------------------END-PROLOGUE--------------------------------
--::::::::::
--sritests.doc
--::::::::::
PERFORMANCE TESTING OF SOME ADA PROGRAMMING CONTRUCTS
SRI is developing a packet switched network node, using the Ada
programming language, and using the SUN Microsystem processor board as
the target hardware, which contains a MC68000. We have run some timing
measurements on specially written Ada test programs in order to
determine how to optimally use tasking, rendevous, selects, and
parameter passing, and also to make an early prediction on the
packet-per-second throughput of the system.
The test were compiled with the Telesoft Ada Compiler on a Diskless SUN
Workstation, running UNIX 4.1c bsd. The workstation was configured
with 2 megabytes of local memory, and only a single user was logged in.
When the Run command is given to start the Ada program, it takes about
5 seconds for the run-time support environment to be loaded to the
diskless sun. Therefore timing is not started until a prompt from the
program is answered by the user with a carriage return. Timing is done
manually with a stopwatch. The program may optionally turn on
printing, to check for deadlock situations, by answering the promt with
a 'y' - this of course slows down the program, and these runs should
not be used for performance measuring.
Most of the timings for each program were repeated 5 times, and the
variance in time was seldom more than a second. Timings given are the
averages for multiple trials.
Following the times below is a summary of the program characteristics
and the conclusions drawn from the tests.
program cycles seconds
________________________________________
chain2 1000 3.57
chain5 1000 10.15
chain10 1000 19.66
chain20 1000 38.03
idle1 10000 29.46
idle5 -
idle10 -
idle20 10000 29.93
select2 1000 4.38
select2e 1000 4.38
select20 1000 8.42
select20e 1000 8.33
guard2 1000 4.28
guard2e 1000 4.22
guard20 1000 6.20
guard20e 1000 6.11
guard20t 1000 8.31
guard20et 1000 8.11
chain2n 10000 29.58
chain2pkt 10000 29.77
chain2ptr 10000 29.98
passarrys 10000 29.
passarryb 10000 29.
passinout 10000 29.
moretasks 1000 38.
moretasksl 1000 47.
moreselct 1000 128.
moreselctr 1000 130.
order31 100 28.
order31r 100 28.
order32 compiles without errors, but crashes when run
order100 compiles without errors, but crashes when run
DESCRIPTION OF TEST PROGRAMS AND RESULTS
CHAIN - TO DETERMINE OVERHEAD IN CONTEXTS SWITCHES BETWEEN TASKS
Each chain task, within each cycle of the loop, calls an entry in the
"next task" in a chain of tasks, the called entry contains a null
statement and returns, and the tasks then waits to be called by another
task at a similar entry of its own. Thus each task is run in turn
dependent on its position in the chain. Chains of length 2, 5, 10, and
20 tasks were compared after 1000 complete cycles around the chain.
Times recorded were
chain2 1000 3.57
chain5 1000 10.15
chain10 1000 19.66
chain20 1000 38.03
Dividing these times by the number of tasks in each test yields
respectively 1.78, 2.03, 1.96, and 1.90; dividing by the number of
cycles then indicates that each context switch (rendezvous) costs about
2 millisec.
IDLE - DETERMINE WHETHER IDLE TASKS IMPACT PERFORMANCE
A chain of length 2 as described above was cycled 10000 times, before
the cycles are started, some number of "idle" task are called at an
"init" entry and are then left waiting at a "never" entry which will
never be called. The timings for 1 and 20 idle task are recorded below
idle1 10000 29.46
idle5 -
idle10 -
idle20 10000 29.93
Within the accuracy of the measurements, there is no difference
in the timings, which implies that there is no performance penalty
for increasing numbers of tasks waiting on a single entrys.
SELECT - DOES THE NUMBER OF SELECT CHOICES MATTER
One task calls a single entry of a second task 1000 times, but
the second task has a select statement encompassing some
number of alternatives. The test was done for 2 and 20
alternatives, with the desired entry being the first one
in the select list, and repeated for the desired entry
being at the end of the select list.
select2 1000 4.38
select2e 1000 4.38
select20 1000 8.42
select20e 1000 8.33
These results show that large select statements are costly.
GUARDS - DO GUARDS ON ENTRY STATEMENTS IMPACT PERFORMANCE
The select tests above were repeated with boolean guards placed
in front of all the entry choices. In some cases, only the
guard on the entry which would really be called was true, and
all of the other guards were false. In other cases, all of the
guards were set to true.
guard2 1000 4.28
guard2e 1000 4.22
guard20 1000 6.20
guard20e 1000 6.11
guard20t 1000 8.31
guard20et 1000 8.11
Comparing these results with the previous tests, it appears that
the cost of using guards on select entrys is very small.
A guard which evaluates to false apparently significantly reduces the overhead
of evaluating the guarded select.
PARAMETERS - WHAT IS THE IMPACT OF PASSING PARAMETERS IN RENDEVOUS
The following chain test were run passing "no" parameters, passing
a packet record as a parameter, and passing a pointer to a record.
chain2n 10000 29.58
chain2pkt 10000 29.77
chain2ptr 10000 29.98
The results show the there is no measurable cost in using entry parameters.
PARAMETER SIZE - DOES SIZE OF THE PASSED PARAMETER MAKE A DIFFERENCE
The above test was repeated with a parameters as follows. A "in"
small integer array of length 2, an "in" integer array length 32000,
and an "in out" integer array length 32000.
passarrys 10000 29.
passarryb 10000 29.
passinout 10000 29.
There is no observed cost in using large structures as parameters.
TASKS - IS IT BETTER TO HAVE LOTS OF LITTLE TASKS WITH SINGLE ENTRY CHOICES
OR FEW BIG TASKS WITH MANY SELECT CHOICES
Some of the previous results would imply the use of many tasks.
In the "moretasks" tests, a master tasks calls each of 20 slave tasks,
each with a single entry. In "moretasksl" each task again has a single
entry, but it is embedded in a select statement for fair comparison
to the next test. In "moreselct" a master task calls each of the 20
entrys in a single slave task, and the slave task has the 20 entrys
embedded in a large select statement. In the "moreselctr" the 20
entrys are listed in the opposite order to which the master calls them.
moretasks 1000 38.
moretasksl 1000 47.
moreselct 1000 128.
moreselctr 1000 130.
The results suggest to use lots of tasks with few select choices.
ORDER - DOES ORDERING OF ENTRY CLAUSES IN A SELECT MATTER
The "moreselct" test was modified by increasing the number of
entry clauses to 100. However it was discovered that a
select statement can only contain a maximum of 31 choices.
Then the program was run for 100 cycles. Another test was
run calling the entrys in the reverse of the select statement.
order31 100 28.
order31r 100 28.
order32 compiles without errors, but crashes when run
order100 compiles without errors, but crashes when run
No difference was determined, however if a large select clause
were permitted (100 entries) it may have suggested which ordering
was optimal.
SCHEDTEST - DETERMINE WHETHER THE ADA SCHEDULER MAY STARVE A TASK
A slave task with a two entry select statement is used independently by
three other tasks. The test is run until the slave has been called
1000 times. Two of the tasks call the first entry, and the third task
calls the second slave entry. Each task, and the slave have print
statements to help determine which task is running. The order and
relative frequency of the tasks printout will show whether any of the
task are starved or run more often than the others. When the test was
run, it was seen that the three tasks alternately print their rendezous
annoucement once each. Thus, none of the tasks were starved, and
rescheduling apparently occurs with the frequency of one rendezous.
CONCLUSIONS
The overhead of a rendevous or task context switch takes 1 - 2 millisecs.
The number of idle tasks waiting on uncalled entries, do not impact speed.
The number of entrys in a select significantly impacts selection speed.
Evaluation of "when" clauses is quick, and when false, prevent the
long select evaluation time, speeding the system.
Passing parameters in rendezous is quick, and there is not much difference
on parameter size or whether "in" or "in out".
The ordering of entrys in a select clause in not important.
To build an optimized system, use more tasks, each with less number
of entries in select clauses, and use guards.
CAUTIONS
Array index are apparently limited to 32000 elements.
Selects may have no more than 31 possible entries.
TELESOFT COMPILER LIMITATIONS
The Telesoft Ada Compiler that we have used for performing these
benchmarks is not a complete implementation of the language. Telesoft
is currently in the process of validating their full Ada compiler, and
we will then get an update with the full language implemented. Some of
the deficiencies of the language, which affected our selection of
benchmarks and programming style, are generics, subunits, some pragmas,
representation specifications, tasks types, entry families, timed entry
calls and the calendar package, and the abort statement.
SUGGESTIONS FOR FURTHER ADA BENCHMARK STUDIES
Most of the test which we performed were concerned with determining how
to optimize task and select statement organization. However, it is
important to understand many of the other facilites of the rich
language, some of which are not yet implemented in our compiler.
Particularly in our application of a real time packet switching node,
we should study the performance of representation specifications, low
level input/output, the timing facilities, aborts, and interrupt
handling.
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** CHAIN2 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** CHAIN5 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link2 is
entry give;
end link2;
task link3 is
entry give;
end link3;
task link4 is
entry give;
end link4;
task link5 is
entry give;
end link5;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link2.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link2 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link2"); end if;
link3.give;
end loop;
end link2;
task body link3 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link3"); end if;
link4.give;
end loop;
end link3;
task body link4 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link4"); end if;
link5.give;
end loop;
end link4;
task body link5 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link5"); end if;
head.give;
end loop;
end link5;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** CHAIN10 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link2 is
entry give;
end link2;
task link3 is
entry give;
end link3;
task link4 is
entry give;
end link4;
task link5 is
entry give;
end link5;
task link11 is
entry give;
end link11;
task link12 is
entry give;
end link12;
task link13 is
entry give;
end link13;
task link14 is
entry give;
end link14;
task link15 is
entry give;
end link15;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link2.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link2 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link2"); end if;
link3.give;
end loop;
end link2;
task body link3 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link3"); end if;
link4.give;
end loop;
end link3;
task body link4 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link4"); end if;
link5.give;
end loop;
end link4;
task body link5 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link5"); end if;
link11.give;
end loop;
end link5;
task body link11 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link11"); end if;
link12.give;
end loop;
end link11;
task body link12 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link12"); end if;
link13.give;
end loop;
end link12;
task body link13 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link13"); end if;
link14.give;
end loop;
end link13;
task body link14 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link14"); end if;
link15.give;
end loop;
end link14;
task body link15 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link15"); end if;
head.give;
end loop;
end link15;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** CHAIN20 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link2 is
entry give;
end link2;
task link3 is
entry give;
end link3;
task link4 is
entry give;
end link4;
task link5 is
entry give;
end link5;
task link11 is
entry give;
end link11;
task link12 is
entry give;
end link12;
task link13 is
entry give;
end link13;
task link14 is
entry give;
end link14;
task link15 is
entry give;
end link15;
task link21 is
entry give;
end link21;
task link22 is
entry give;
end link22;
task link23 is
entry give;
end link23;
task link24 is
entry give;
end link24;
task link25 is
entry give;
end link25;
task link211 is
entry give;
end link211;
task link212 is
entry give;
end link212;
task link213 is
entry give;
end link213;
task link214 is
entry give;
end link214;
task link215 is
entry give;
end link215;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link2.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link2 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link2"); end if;
link3.give;
end loop;
end link2;
task body link3 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link3"); end if;
link4.give;
end loop;
end link3;
task body link4 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link4"); end if;
link5.give;
end loop;
end link4;
task body link5 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link5"); end if;
link11.give;
end loop;
end link5;
task body link11 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link11"); end if;
link12.give;
end loop;
end link11;
task body link12 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link12"); end if;
link13.give;
end loop;
end link12;
task body link13 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link13"); end if;
link14.give;
end loop;
end link13;
task body link14 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link14"); end if;
link15.give;
end loop;
end link14;
task body link15 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link15"); end if;
link21.give;
end loop;
end link15;
task body link21 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link21"); end if;
link22.give;
end loop;
end link21;
task body link22 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link22"); end if;
link23.give;
end loop;
end link22;
task body link23 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link23"); end if;
link24.give;
end loop;
end link23;
task body link24 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link24"); end if;
link25.give;
end loop;
end link24;
task body link25 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link25"); end if;
link211.give;
end loop;
end link25;
task body link211 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link211"); end if;
link212.give;
end loop;
end link211;
task body link212 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link212"); end if;
link213.give;
end loop;
end link212;
task body link213 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link213"); end if;
link214.give;
end loop;
end link213;
task body link214 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link214"); end if;
link215.give;
end loop;
end link214;
task body link215 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link215"); end if;
head.give;
end loop;
end link215;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** IDLE1 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
end link1;
task idle1 is
entry init;
entry never;
end idle1;
task body head is
begin
idle1.init;
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
task body idle1 is
begin
accept init do put_line("idle1"); end init;
accept never do null; end never;
end idle1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** IDLE5 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
end link1;
task idle1 is
entry init;
entry never;
end idle1;
task idle2 is
entry init;
entry never;
end idle2;
task idle3 is
entry init;
entry never;
end idle3;
task idle4 is
entry init;
entry never;
end idle4;
task idle5 is
entry init;
entry never;
end idle5;
task body head is
begin
idle1.init;
idle2.init;
idle3.init;
idle4.init;
idle5.init;
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
task body idle1 is
begin
accept init do put_line("idle1"); end init;
accept never do null; end never;
end idle1;
task body idle2 is
begin
accept init do put_line("idle2"); end init;
accept never do null; end never;
end idle2;
task body idle3 is
begin
accept init do put_line("idle3"); end init;
accept never do null; end never;
end idle3;
task body idle4 is
begin
accept init do put_line("idle4"); end init;
accept never do null; end never;
end idle4;
task body idle5 is
begin
accept init do put_line("idle5"); end init;
accept never do null; end never;
end idle5;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** IDLE10 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
end link1;
task idle1 is
entry init;
entry never;
end idle1;
task idle2 is
entry init;
entry never;
end idle2;
task idle3 is
entry init;
entry never;
end idle3;
task idle4 is
entry init;
entry never;
end idle4;
task idle5 is
entry init;
entry never;
end idle5;
task idle11 is
entry init;
entry never;
end idle11;
task idle12 is
entry init;
entry never;
end idle12;
task idle13 is
entry init;
entry never;
end idle13;
task idle14 is
entry init;
entry never;
end idle14;
task idle15 is
entry init;
entry never;
end idle15;
task body head is
begin
idle1.init;
idle2.init;
idle3.init;
idle4.init;
idle5.init;
idle11.init;
idle12.init;
idle13.init;
idle14.init;
idle15.init;
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
task body idle1 is
begin
accept init do put_line("idle1"); end init;
accept never do null; end never;
end idle1;
task body idle2 is
begin
accept init do put_line("idle2"); end init;
accept never do null; end never;
end idle2;
task body idle3 is
begin
accept init do put_line("idle3"); end init;
accept never do null; end never;
end idle3;
task body idle4 is
begin
accept init do put_line("idle4"); end init;
accept never do null; end never;
end idle4;
task body idle5 is
begin
accept init do put_line("idle5"); end init;
accept never do null; end never;
end idle5;
task body idle11 is
begin
accept init do put_line("idle11"); end init;
accept never do null; end never;
end idle11;
task body idle12 is
begin
accept init do put_line("idle12"); end init;
accept never do null; end never;
end idle12;
task body idle13 is
begin
accept init do put_line("idle13"); end init;
accept never do null; end never;
end idle13;
task body idle14 is
begin
accept init do put_line("idle14"); end init;
accept never do null; end never;
end idle14;
task body idle15 is
begin
accept init do put_line("idle15"); end init;
accept never do null; end never;
end idle15;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** IDLE20 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
end link1;
task idle1 is
entry init;
entry never;
end idle1;
task idle2 is
entry init;
entry never;
end idle2;
task idle3 is
entry init;
entry never;
end idle3;
task idle4 is
entry init;
entry never;
end idle4;
task idle5 is
entry init;
entry never;
end idle5;
task idle11 is
entry init;
entry never;
end idle11;
task idle12 is
entry init;
entry never;
end idle12;
task idle13 is
entry init;
entry never;
end idle13;
task idle14 is
entry init;
entry never;
end idle14;
task idle15 is
entry init;
entry never;
end idle15;
task idle21 is
entry init;
entry never;
end idle21;
task idle22 is
entry init;
entry never;
end idle22;
task idle23 is
entry init;
entry never;
end idle23;
task idle24 is
entry init;
entry never;
end idle24;
task idle25 is
entry init;
entry never;
end idle25;
task idle211 is
entry init;
entry never;
end idle211;
task idle212 is
entry init;
entry never;
end idle212;
task idle213 is
entry init;
entry never;
end idle213;
task idle214 is
entry init;
entry never;
end idle214;
task idle215 is
entry init;
entry never;
end idle215;
task body head is
begin
idle1.init;
idle2.init;
idle3.init;
idle4.init;
idle5.init;
idle11.init;
idle12.init;
idle13.init;
idle14.init;
idle15.init;
idle21.init;
idle22.init;
idle23.init;
idle24.init;
idle25.init;
idle211.init;
idle212.init;
idle213.init;
idle214.init;
idle215.init;
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
task body idle1 is
begin
accept init do put_line("idle1"); end init;
accept never do null; end never;
end idle1;
task body idle2 is
begin
accept init do put_line("idle2"); end init;
accept never do null; end never;
end idle2;
task body idle3 is
begin
accept init do put_line("idle3"); end init;
accept never do null; end never;
end idle3;
task body idle4 is
begin
accept init do put_line("idle4"); end init;
accept never do null; end never;
end idle4;
task body idle5 is
begin
accept init do put_line("idle5"); end init;
accept never do null; end never;
end idle5;
task body idle11 is
begin
accept init do put_line("idle11"); end init;
accept never do null; end never;
end idle11;
task body idle12 is
begin
accept init do put_line("idle12"); end init;
accept never do null; end never;
end idle12;
task body idle13 is
begin
accept init do put_line("idle13"); end init;
accept never do null; end never;
end idle13;
task body idle14 is
begin
accept init do put_line("idle14"); end init;
accept never do null; end never;
end idle14;
task body idle15 is
begin
accept init do put_line("idle15"); end init;
accept never do null; end never;
end idle15;
task body idle21 is
begin
accept init do put_line("idle21"); end init;
accept never do null; end never;
end idle21;
task body idle22 is
begin
accept init do put_line("idle22"); end init;
accept never do null; end never;
end idle22;
task body idle23 is
begin
accept init do put_line("idle23"); end init;
accept never do null; end never;
end idle23;
task body idle24 is
begin
accept init do put_line("idle24"); end init;
accept never do null; end never;
end idle24;
task body idle25 is
begin
accept init do put_line("idle25"); end init;
accept never do null; end never;
end idle25;
task body idle211 is
begin
accept init do put_line("idle211"); end init;
accept never do null; end never;
end idle211;
task body idle212 is
begin
accept init do put_line("idle212"); end init;
accept never do null; end never;
end idle212;
task body idle213 is
begin
accept init do put_line("idle213"); end init;
accept never do null; end never;
end idle213;
task body idle214 is
begin
accept init do put_line("idle214"); end init;
accept never do null; end never;
end idle214;
task body idle215 is
begin
accept init do put_line("idle215"); end init;
accept never do null; end never;
end idle215;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** SELECT2 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept give do
null;
end give;
or accept s2 do null; end s2;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** SELECT2E *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept s2 do null; end s2;
or accept give do
null;
end give;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** SELECT20 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
entry s3;
entry s4;
entry s5;
entry s6;
entry s7;
entry s8;
entry s9;
entry s10;
entry s11;
entry s12;
entry s13;
entry s14;
entry s15;
entry s16;
entry s17;
entry s18;
entry s19;
entry s20;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept give do
null;
end give;
or accept s2 do null; end s2;
or accept s3 do null; end s3;
or accept s4 do null; end s4;
or accept s5 do null; end s5;
or accept s6 do null; end s6;
or accept s7 do null; end s7;
or accept s8 do null; end s8;
or accept s9 do null; end s9;
or accept s10 do null; end s10;
or accept s11 do null; end s11;
or accept s12 do null; end s12;
or accept s13 do null; end s13;
or accept s14 do null; end s14;
or accept s15 do null; end s15;
or accept s16 do null; end s16;
or accept s17 do null; end s17;
or accept s18 do null; end s18;
or accept s19 do null; end s19;
or accept s20 do null; end s20;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** SELECT20E *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
entry s3;
entry s4;
entry s5;
entry s6;
entry s7;
entry s8;
entry s9;
entry s10;
entry s11;
entry s12;
entry s13;
entry s14;
entry s15;
entry s16;
entry s17;
entry s18;
entry s19;
entry s20;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept s2 do null; end s2;
or accept s3 do null; end s3;
or accept s4 do null; end s4;
or accept s5 do null; end s5;
or accept s6 do null; end s6;
or accept s7 do null; end s7;
or accept s8 do null; end s8;
or accept s9 do null; end s9;
or accept s10 do null; end s10;
or accept s11 do null; end s11;
or accept s12 do null; end s12;
or accept s13 do null; end s13;
or accept s14 do null; end s14;
or accept s15 do null; end s15;
or accept s16 do null; end s16;
or accept s17 do null; end s17;
or accept s18 do null; end s18;
or accept s19 do null; end s19;
or accept s20 do null; end s20;
or accept give do
null;
end give;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** GUARD2 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
g1: boolean := true;
g2: boolean := false;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
when g1 => accept give do null; end give;
or when g2 => accept s2 do null; end s2;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** GUARD2E *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
g1: boolean := true;
g2: boolean := false;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
when g2 => accept s2 do null; end s2;
or when g1 => accept give do null; end give;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** GUARD20 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
g1: boolean := true;
g2: boolean := false;
g3: boolean := false;
g4: boolean := false;
g5: boolean := false;
g6: boolean := false;
g7: boolean := false;
g8: boolean := false;
g9: boolean := false;
g10: boolean := false;
g11: boolean := false;
g12: boolean := false;
g13: boolean := false;
g14: boolean := false;
g15: boolean := false;
g16: boolean := false;
g17: boolean := false;
g18: boolean := false;
g19: boolean := false;
g20: boolean := false;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
entry s3;
entry s4;
entry s5;
entry s6;
entry s7;
entry s8;
entry s9;
entry s10;
entry s11;
entry s12;
entry s13;
entry s14;
entry s15;
entry s16;
entry s17;
entry s18;
entry s19;
entry s20;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
when g1 => accept give do null; end give;
or when g2 => accept s2 do null; end s2;
or when g3 => accept s3 do null; end s3;
or when g4 => accept s4 do null; end s4;
or when g5 => accept s5 do null; end s5;
or when g6 => accept s6 do null; end s6;
or when g7 => accept s7 do null; end s7;
or when g8 => accept s8 do null; end s8;
or when g9 => accept s9 do null; end s9;
or when g10 => accept s10 do null; end s10;
or when g11 => accept s11 do null; end s11;
or when g12 => accept s12 do null; end s12;
or when g13 => accept s13 do null; end s13;
or when g14 => accept s14 do null; end s14;
or when g15 => accept s15 do null; end s15;
or when g16 => accept s16 do null; end s16;
or when g17 => accept s17 do null; end s17;
or when g18 => accept s18 do null; end s18;
or when g19 => accept s19 do null; end s19;
or when g20 => accept s20 do null; end s20;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** GUARD20E *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
g1: boolean := true;
g2: boolean := false;
g3: boolean := false;
g4: boolean := false;
g5: boolean := false;
g6: boolean := false;
g7: boolean := false;
g8: boolean := false;
g9: boolean := false;
g10: boolean := false;
g11: boolean := false;
g12: boolean := false;
g13: boolean := false;
g14: boolean := false;
g15: boolean := false;
g16: boolean := false;
g17: boolean := false;
g18: boolean := false;
g19: boolean := false;
g20: boolean := false;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
entry s3;
entry s4;
entry s5;
entry s6;
entry s7;
entry s8;
entry s9;
entry s10;
entry s11;
entry s12;
entry s13;
entry s14;
entry s15;
entry s16;
entry s17;
entry s18;
entry s19;
entry s20;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
when g2 => accept s2 do null; end s2;
or when g3 => accept s3 do null; end s3;
or when g4 => accept s4 do null; end s4;
or when g5 => accept s5 do null; end s5;
or when g6 => accept s6 do null; end s6;
or when g7 => accept s7 do null; end s7;
or when g8 => accept s8 do null; end s8;
or when g9 => accept s9 do null; end s9;
or when g10 => accept s10 do null; end s10;
or when g11 => accept s11 do null; end s11;
or when g12 => accept s12 do null; end s12;
or when g13 => accept s13 do null; end s13;
or when g14 => accept s14 do null; end s14;
or when g15 => accept s15 do null; end s15;
or when g16 => accept s16 do null; end s16;
or when g17 => accept s17 do null; end s17;
or when g18 => accept s18 do null; end s18;
or when g19 => accept s19 do null; end s19;
or when g20 => accept s20 do null; end s20;
or when g1 => accept give do null; end give;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** GUARD20T *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
g1: boolean := true;
g2: boolean := true;
g3: boolean := true;
g4: boolean := true;
g5: boolean := true;
g6: boolean := true;
g7: boolean := true;
g8: boolean := true;
g9: boolean := true;
g10: boolean := true;
g11: boolean := true;
g12: boolean := true;
g13: boolean := true;
g14: boolean := true;
g15: boolean := true;
g16: boolean := true;
g17: boolean := true;
g18: boolean := true;
g19: boolean := true;
g20: boolean := true;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
entry s3;
entry s4;
entry s5;
entry s6;
entry s7;
entry s8;
entry s9;
entry s10;
entry s11;
entry s12;
entry s13;
entry s14;
entry s15;
entry s16;
entry s17;
entry s18;
entry s19;
entry s20;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
when g1 => accept give do null; end give;
or when g2 => accept s2 do null; end s2;
or when g3 => accept s3 do null; end s3;
or when g4 => accept s4 do null; end s4;
or when g5 => accept s5 do null; end s5;
or when g6 => accept s6 do null; end s6;
or when g7 => accept s7 do null; end s7;
or when g8 => accept s8 do null; end s8;
or when g9 => accept s9 do null; end s9;
or when g10 => accept s10 do null; end s10;
or when g11 => accept s11 do null; end s11;
or when g12 => accept s12 do null; end s12;
or when g13 => accept s13 do null; end s13;
or when g14 => accept s14 do null; end s14;
or when g15 => accept s15 do null; end s15;
or when g16 => accept s16 do null; end s16;
or when g17 => accept s17 do null; end s17;
or when g18 => accept s18 do null; end s18;
or when g19 => accept s19 do null; end s19;
or when g20 => accept s20 do null; end s20;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** GUARD20ET *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
g1: boolean := true;
g2: boolean := true;
g3: boolean := true;
g4: boolean := true;
g5: boolean := true;
g6: boolean := true;
g7: boolean := true;
g8: boolean := true;
g9: boolean := true;
g10: boolean := true;
g11: boolean := true;
g12: boolean := true;
g13: boolean := true;
g14: boolean := true;
g15: boolean := true;
g16: boolean := true;
g17: boolean := true;
g18: boolean := true;
g19: boolean := true;
g20: boolean := true;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
entry s3;
entry s4;
entry s5;
entry s6;
entry s7;
entry s8;
entry s9;
entry s10;
entry s11;
entry s12;
entry s13;
entry s14;
entry s15;
entry s16;
entry s17;
entry s18;
entry s19;
entry s20;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
when g2 => accept s2 do null; end s2;
or when g3 => accept s3 do null; end s3;
or when g4 => accept s4 do null; end s4;
or when g5 => accept s5 do null; end s5;
or when g6 => accept s6 do null; end s6;
or when g7 => accept s7 do null; end s7;
or when g8 => accept s8 do null; end s8;
or when g9 => accept s9 do null; end s9;
or when g10 => accept s10 do null; end s10;
or when g11 => accept s11 do null; end s11;
or when g12 => accept s12 do null; end s12;
or when g13 => accept s13 do null; end s13;
or when g14 => accept s14 do null; end s14;
or when g15 => accept s15 do null; end s15;
or when g16 => accept s16 do null; end s16;
or when g17 => accept s17 do null; end s17;
or when g18 => accept s18 do null; end s18;
or when g19 => accept s19 do null; end s19;
or when g20 => accept s20 do null; end s20;
or when g1 => accept give do null; end give;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** CHAIN2N *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** CHAIN2PKT *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
type vector is array(integer range <>) of integer;
type pkt_type;
type pkt_ptr is access pkt_type;
type pkt_type is record
next: pkt_ptr;
header: vector(1..25);
data: string(1..50);
tailer: vector(1..25);
end record;
task head is
entry give(p:in pkt_type);
end head;
task link1 is
entry give(p:in pkt_type);
end link1;
task body head is
pkt : pkt_type;
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give(pkt);
accept give(p:in pkt_type) do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
pkt: pkt_type;
begin
loop
accept give(p:in pkt_type) do
null;
end give;
if printon then put_line("link1"); end if;
head.give(pkt);
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** CHAIN2PTR *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
type vector is array(integer range <>) of integer;
type pkt_type;
type pkt_ptr is access pkt_type;
type pkt_type is record
next: pkt_ptr;
header: vector(1..25);
data: string(1..50);
tailer: vector(1..25);
end record;
task head is
entry give(p:in pkt_ptr);
end head;
task link1 is
entry give(p:in pkt_ptr);
end link1;
task body head is
pkt : pkt_ptr;
begin
pkt := new pkt_type;
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give(pkt);
accept give(p:in pkt_ptr) do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
pkt: pkt_ptr;
begin
pkt := new pkt_type;
loop
accept give(p:in pkt_ptr) do
null;
end give;
if printon then put_line("link1"); end if;
head.give(pkt);
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** PASSARRYS *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
type param_type is array(1..2) of character;
task head is
entry give(p:in param_type);
end head;
task link1 is
entry give(p:in param_type);
end link1;
task body head is
p : param_type;
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give(p);
accept give(p:in param_type) do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
p: param_type;
begin
loop
accept give(p:in param_type) do
null;
end give;
if printon then put_line("link1"); end if;
head.give(p);
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** PASSARRYB *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
-- 32000 is biggest char arry legal
type param_type is array(1..32000) of integer;
task head is
entry give(p:in param_type);
end head;
task link1 is
entry give(p:in param_type);
end link1;
task body head is
p : param_type;
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give(p);
accept give(p:in param_type) do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
p: param_type;
begin
loop
accept give(p:in param_type) do
null;
end give;
if printon then put_line("link1"); end if;
head.give(p);
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** PASSINOUT *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
-- 32000 is biggest char arry legal
type param_type is array(1..32000) of integer;
task head is
entry give(p:in out param_type);
end head;
task link1 is
entry give(p:in out param_type);
end link1;
task body head is
p : param_type;
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give(p);
accept give(p:in out param_type) do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
p: param_type;
begin
loop
accept give(p:in out param_type) do
null;
end give;
if printon then put_line("link1"); end if;
head.give(p);
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
*I
***** MORETASKS *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head;
task link1 is
entry give;
end link1;
task link2 is
entry give;
end link2;
task link3 is
entry give;
end link3;
task link4 is
entry give;
end link4;
task link5 is
entry give;
end link5;
task link6 is
entry give;
end link6;
task link7 is
entry give;
end link7;
task link8 is
entry give;
end link8;
task link9 is
entry give;
end link9;
task link10 is
entry give;
end link10;
task link11 is
entry give;
end link11;
task link12 is
entry give;
end link12;
task link13 is
entry give;
end link13;
task link14 is
entry give;
end link14;
task link15 is
entry give;
end link15;
task link16 is
entry give;
end link16;
task link17 is
entry give;
end link17;
task link18 is
entry give;
end link18;
task link19 is
entry give;
end link19;
task link20 is
entry give;
end link20;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
link2.give;
link3.give;
link4.give;
link5.give;
link6.give;
link7.give;
link8.give;
link9.give;
link10.give;
link11.give;
link12.give;
link13.give;
link14.give;
link15.give;
link16.give;
link17.give;
link18.give;
link19.give;
link20.give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
accept give do
null;
end give;
end loop;
end link1;
task body link2 is
begin
loop
accept give do
null;
end give;
end loop;
end link2;
task body link3 is
begin
loop
accept give do
null;
end give;
end loop;
end link3;
task body link4 is
begin
loop
accept give do
null;
end give;
end loop;
end link4;
task body link5 is
begin
loop
accept give do
null;
end give;
end loop;
end link5;
task body link6 is
begin
loop
accept give do
null;
end give;
end loop;
end link6;
task body link7 is
begin
loop
accept give do
null;
end give;
end loop;
end link7;
task body link8 is
begin
loop
accept give do
null;
end give;
end loop;
end link8;
task body link9 is
begin
loop
accept give do
null;
end give;
end loop;
end link9;
task body link10 is
begin
loop
accept give do
null;
end give;
end loop;
end link10;
task body link11 is
begin
loop
accept give do
null;
end give;
end loop;
end link11;
task body link12 is
begin
loop
accept give do
null;
end give;
end loop;
end link12;
task body link13 is
begin
loop
accept give do
null;
end give;
end loop;
end link13;
task body link14 is
begin
loop
accept give do
null;
end give;
end loop;
end link14;
task body link15 is
begin
loop
accept give do
null;
end give;
end loop;
end link15;
task body link16 is
begin
loop
accept give do
null;
end give;
end loop;
end link16;
task body link17 is
begin
loop
accept give do
null;
end give;
end loop;
end link17;
task body link18 is
begin
loop
accept give do
null;
end give;
end loop;
end link18;
task body link19 is
begin
loop
accept give do
null;
end give;
end loop;
end link19;
task body link20 is
begin
loop
accept give do
null;
end give;
end loop;
end link20;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** MORETASKSL *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head;
task link1 is
entry give;
end link1;
task link2 is
entry give;
end link2;
task link3 is
entry give;
end link3;
task link4 is
entry give;
end link4;
task link5 is
entry give;
end link5;
task link6 is
entry give;
end link6;
task link7 is
entry give;
end link7;
task link8 is
entry give;
end link8;
task link9 is
entry give;
end link9;
task link10 is
entry give;
end link10;
task link11 is
entry give;
end link11;
task link12 is
entry give;
end link12;
task link13 is
entry give;
end link13;
task link14 is
entry give;
end link14;
task link15 is
entry give;
end link15;
task link16 is
entry give;
end link16;
task link17 is
entry give;
end link17;
task link18 is
entry give;
end link18;
task link19 is
entry give;
end link19;
task link20 is
entry give;
end link20;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
link2.give;
link3.give;
link4.give;
link5.give;
link6.give;
link7.give;
link8.give;
link9.give;
link10.give;
link11.give;
link12.give;
link13.give;
link14.give;
link15.give;
link16.give;
link17.give;
link18.give;
link19.give;
link20.give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link1;
task body link2 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link2;
task body link3 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link3;
task body link4 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link4;
task body link5 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link5;
task body link6 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link6;
task body link7 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link7;
task body link8 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link8;
task body link9 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link9;
task body link10 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link10;
task body link11 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link11;
task body link12 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link12;
task body link13 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link13;
task body link14 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link14;
task body link15 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link15;
task body link16 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link16;
task body link17 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link17;
task body link18 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link18;
task body link19 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link19;
task body link20 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link20;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** MORESELCT *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head;
task link1 is
entry give1;
entry give2;
entry give3;
entry give4;
entry give5;
entry give6;
entry give7;
entry give8;
entry give9;
entry give10;
entry give11;
entry give12;
entry give13;
entry give14;
entry give15;
entry give16;
entry give17;
entry give18;
entry give19;
entry give20;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give1;
link1.give2;
link1.give3;
link1.give4;
link1.give5;
link1.give6;
link1.give7;
link1.give8;
link1.give9;
link1.give10;
link1.give11;
link1.give12;
link1.give13;
link1.give14;
link1.give15;
link1.give16;
link1.give17;
link1.give18;
link1.give19;
link1.give20;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept give1 do null; end give1;
or accept give2 do null; end give2;
or accept give3 do null; end give3;
or accept give4 do null; end give4;
or accept give5 do null; end give5;
or accept give6 do null; end give6;
or accept give7 do null; end give7;
or accept give8 do null; end give8;
or accept give9 do null; end give9;
or accept give10 do null; end give10;
or accept give11 do null; end give11;
or accept give12 do null; end give12;
or accept give13 do null; end give13;
or accept give14 do null; end give14;
or accept give15 do null; end give15;
or accept give16 do null; end give16;
or accept give17 do null; end give17;
or accept give18 do null; end give18;
or accept give19 do null; end give19;
or accept give20 do null; end give20;
end select;
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** MORESELCTR *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head;
task link1 is
entry give1;
entry give2;
entry give3;
entry give4;
entry give5;
entry give6;
entry give7;
entry give8;
entry give9;
entry give10;
entry give11;
entry give12;
entry give13;
entry give14;
entry give15;
entry give16;
entry give17;
entry give18;
entry give19;
entry give20;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give1;
link1.give2;
link1.give3;
link1.give4;
link1.give5;
link1.give6;
link1.give7;
link1.give8;
link1.give9;
link1.give10;
link1.give11;
link1.give12;
link1.give13;
link1.give14;
link1.give15;
link1.give16;
link1.give17;
link1.give18;
link1.give19;
link1.give20;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept give20 do null; end give20;
or accept give19 do null; end give19;
or accept give18 do null; end give18;
or accept give17 do null; end give17;
or accept give16 do null; end give16;
or accept give15 do null; end give15;
or accept give14 do null; end give14;
or accept give13 do null; end give13;
or accept give12 do null; end give12;
or accept give11 do null; end give11;
or accept give10 do null; end give10;
or accept give9 do null; end give9;
or accept give8 do null; end give8;
or accept give7 do null; end give7;
or accept give6 do null; end give6;
or accept give5 do null; end give5;
or accept give4 do null; end give4;
or accept give3 do null; end give3;
or accept give2 do null; end give2;
or accept give1 do null; end give1;
end select;
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** ORDER31 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head;
task link1 is
entry give1;
entry give2;
entry give3;
entry give4;
entry give5;
entry give6;
entry give7;
entry give8;
entry give9;
entry give10;
entry give11;
entry give12;
entry give13;
entry give14;
entry give15;
entry give16;
entry give17;
entry give18;
entry give19;
entry give20;
entry give21;
entry give22;
entry give23;
entry give24;
entry give25;
entry give26;
entry give27;
entry give28;
entry give29;
entry give30;
entry give31;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 100;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give1;
link1.give2;
link1.give3;
link1.give4;
link1.give5;
link1.give6;
link1.give7;
link1.give8;
link1.give9;
link1.give10;
link1.give11;
link1.give12;
link1.give13;
link1.give14;
link1.give15;
link1.give16;
link1.give17;
link1.give18;
link1.give19;
link1.give20;
link1.give21;
link1.give22;
link1.give23;
link1.give24;
link1.give25;
link1.give26;
link1.give27;
link1.give28;
link1.give29;
link1.give30;
link1.give31;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept give1 do null; end give1;
or accept give2 do null; end give2;
or accept give3 do null; end give3;
or accept give4 do null; end give4;
or accept give5 do null; end give5;
or accept give6 do null; end give6;
or accept give7 do null; end give7;
or accept give8 do null; end give8;
or accept give9 do null; end give9;
or accept give10 do null; end give10;
or accept give11 do null; end give11;
or accept give12 do null; end give12;
or accept give13 do null; end give13;
or accept give14 do null; end give14;
or accept give15 do null; end give15;
or accept give16 do null; end give16;
or accept give17 do null; end give17;
or accept give18 do null; end give18;
or accept give19 do null; end give19;
or accept give20 do null; end give20;
or accept give21 do null; end give1;
or accept give22 do null; end give2;
or accept give23 do null; end give3;
or accept give24 do null; end give4;
or accept give25 do null; end give5;
or accept give26 do null; end give6;
or accept give27 do null; end give7;
or accept give28 do null; end give8;
or accept give29 do null; end give9;
or accept give30 do null; end give10;
or accept give31 do null; end give11;
end select;
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** ORDER31R *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head;
task link1 is
entry give1;
entry give2;
entry give3;
entry give4;
entry give5;
entry give6;
entry give7;
entry give8;
entry give9;
entry give10;
entry give11;
entry give12;
entry give13;
entry give14;
entry give15;
entry give16;
entry give17;
entry give18;
entry give19;
entry give20;
entry give21;
entry give22;
entry give23;
entry give24;
entry give25;
entry give26;
entry give27;
entry give28;
entry give29;
entry give30;
entry give31;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 100;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give31;
link1.give30;
link1.give29;
link1.give28;
link1.give27;
link1.give26;
link1.give25;
link1.give24;
link1.give23;
link1.give22;
link1.give21;
link1.give20;
link1.give19;
link1.give18;
link1.give17;
link1.give16;
link1.give15;
link1.give14;
link1.give13;
link1.give12;
link1.give11;
link1.give10;
link1.give9;
link1.give8;
link1.give7;
link1.give6;
link1.give5;
link1.give4;
link1.give3;
link1.give2;
link1.give1;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept give1 do null; end give1;
or accept give2 do null; end give2;
or accept give3 do null; end give3;
or accept give4 do null; end give4;
or accept give5 do null; end give5;
or accept give6 do null; end give6;
or accept give7 do null; end give7;
or accept give8 do null; end give8;
or accept give9 do null; end give9;
or accept give10 do null; end give10;
or accept give11 do null; end give11;
or accept give12 do null; end give12;
or accept give13 do null; end give13;
or accept give14 do null; end give14;
or accept give15 do null; end give15;
or accept give16 do null; end give16;
or accept give17 do null; end give17;
or accept give18 do null; end give18;
or accept give19 do null; end give19;
or accept give20 do null; end give20;
or accept give21 do null; end give1;
or accept give22 do null; end give2;
or accept give23 do null; end give3;
or accept give24 do null; end give4;
or accept give25 do null; end give5;
or accept give26 do null; end give6;
or accept give27 do null; end give7;
or accept give28 do null; end give8;
or accept give29 do null; end give9;
or accept give30 do null; end give10;
or accept give31 do null; end give11;
end select;
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** ORDER32 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head;
task link1 is
entry give1;
entry give2;
entry give3;
entry give4;
entry give5;
entry give6;
entry give7;
entry give8;
entry give9;
entry give10;
entry give11;
entry give12;
entry give13;
entry give14;
entry give15;
entry give16;
entry give17;
entry give18;
entry give19;
entry give20;
entry give21;
entry give22;
entry give23;
entry give24;
entry give25;
entry give26;
entry give27;
entry give28;
entry give29;
entry give30;
entry give31;
entry give32;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 100;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give1;
link1.give2;
link1.give3;
link1.give4;
link1.give5;
link1.give6;
link1.give7;
link1.give8;
link1.give9;
link1.give10;
link1.give11;
link1.give12;
link1.give13;
link1.give14;
link1.give15;
link1.give16;
link1.give17;
link1.give18;
link1.give19;
link1.give20;
link1.give21;
link1.give22;
link1.give23;
link1.give24;
link1.give25;
link1.give26;
link1.give27;
link1.give28;
link1.give29;
link1.give30;
link1.give31;
link1.give32;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept give1 do null; end give1;
or accept give2 do null; end give2;
or accept give3 do null; end give3;
or accept give4 do null; end give4;
or accept give5 do null; end give5;
or accept give6 do null; end give6;
or accept give7 do null; end give7;
or accept give8 do null; end give8;
or accept give9 do null; end give9;
or accept give10 do null; end give10;
or accept give11 do null; end give11;
or accept give12 do null; end give12;
or accept give13 do null; end give13;
or accept give14 do null; end give14;
or accept give15 do null; end give15;
or accept give16 do null; end give16;
or accept give17 do null; end give17;
or accept give18 do null; end give18;
or accept give19 do null; end give19;
or accept give20 do null; end give20;
or accept give21 do null; end give1;
or accept give22 do null; end give2;
or accept give23 do null; end give3;
or accept give24 do null; end give4;
or accept give25 do null; end give5;
or accept give26 do null; end give6;
or accept give27 do null; end give7;
or accept give28 do null; end give8;
or accept give29 do null; end give9;
or accept give30 do null; end give10;
or accept give31 do null; end give11;
or accept give32 do null; end give12;
end select;
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** ORDER100 *****
*
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head;
task link1 is
entry give1;
entry give2;
entry give3;
entry give4;
entry give5;
entry give6;
entry give7;
entry give8;
entry give9;
entry give10;
entry give11;
entry give12;
entry give13;
entry give14;
entry give15;
entry give16;
entry give17;
entry give18;
entry give19;
entry give20;
entry give21;
entry give22;
entry give23;
entry give24;
entry give25;
entry give26;
entry give27;
entry give28;
entry give29;
entry give30;
entry give31;
entry give32;
entry give33;
entry give34;
entry give35;
entry give36;
entry give37;
entry give38;
entry give39;
entry give40;
entry give41;
entry give42;
entry give43;
entry give44;
entry give45;
entry give46;
entry give47;
entry give48;
entry give49;
entry give50;
entry give51;
entry give52;
entry give53;
entry give54;
entry give55;
entry give56;
entry give57;
entry give58;
entry give59;
entry give60;
entry give61;
entry give62;
entry give63;
entry give64;
entry give65;
entry give66;
entry give67;
entry give68;
entry give69;
entry give70;
entry give71;
entry give72;
entry give73;
entry give74;
entry give75;
entry give76;
entry give77;
entry give78;
entry give79;
entry give80;
entry give81;
entry give82;
entry give83;
entry give84;
entry give85;
entry give86;
entry give87;
entry give88;
entry give89;
entry give90;
entry give91;
entry give92;
entry give93;
entry give94;
entry give95;
entry give96;
entry give97;
entry give98;
entry give99;
entry give100;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 100;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give1;
link1.give2;
link1.give3;
link1.give4;
link1.give5;
link1.give6;
link1.give7;
link1.give8;
link1.give9;
link1.give10;
link1.give11;
link1.give12;
link1.give13;
link1.give14;
link1.give15;
link1.give16;
link1.give17;
link1.give18;
link1.give19;
link1.give20;
link1.give21;
link1.give22;
link1.give23;
link1.give24;
link1.give25;
link1.give26;
link1.give27;
link1.give28;
link1.give29;
link1.give30;
link1.give31;
link1.give32;
link1.give33;
link1.give34;
link1.give35;
link1.give36;
link1.give37;
link1.give38;
link1.give39;
link1.give40;
link1.give41;
link1.give42;
link1.give43;
link1.give44;
link1.give45;
link1.give46;
link1.give47;
link1.give48;
link1.give49;
link1.give50;
link1.give51;
link1.give52;
link1.give53;
link1.give54;
link1.give55;
link1.give56;
link1.give57;
link1.give58;
link1.give59;
link1.give60;
link1.give61;
link1.give62;
link1.give63;
link1.give64;
link1.give65;
link1.give66;
link1.give67;
link1.give68;
link1.give69;
link1.give70;
link1.give71;
link1.give72;
link1.give73;
link1.give74;
link1.give75;
link1.give76;
link1.give77;
link1.give78;
link1.give79;
link1.give80;
link1.give81;
link1.give82;
link1.give83;
link1.give84;
link1.give85;
link1.give86;
link1.give87;
link1.give88;
link1.give89;
link1.give90;
link1.give91;
link1.give92;
link1.give93;
link1.give94;
link1.give95;
link1.give96;
link1.give97;
link1.give98;
link1.give99;
link1.give100;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept give1 do null; end give1;
or accept give2 do null; end give2;
or accept give3 do null; end give3;
or accept give4 do null; end give4;
or accept give5 do null; end give5;
or accept give6 do null; end give6;
or accept give7 do null; end give7;
or accept give8 do null; end give8;
or accept give9 do null; end give9;
or accept give10 do null; end give10;
or accept give11 do null; end give11;
or accept give12 do null; end give12;
or accept give13 do null; end give13;
or accept give14 do null; end give14;
or accept give15 do null; end give15;
or accept give16 do null; end give16;
or accept give17 do null; end give17;
or accept give18 do null; end give18;
or accept give19 do null; end give19;
or accept give20 do null; end give20;
or accept give21 do null; end give1;
or accept give22 do null; end give2;
or accept give23 do null; end give3;
or accept give24 do null; end give4;
or accept give25 do null; end give5;
or accept give26 do null; end give6;
or accept give27 do null; end give7;
or accept give28 do null; end give8;
or accept give29 do null; end give9;
or accept give30 do null; end give10;
or accept give31 do null; end give11;
or accept give32 do null; end give12;
or accept give33 do null; end give13;
or accept give34 do null; end give14;
or accept give35 do null; end give15;
or accept give36 do null; end give16;
or accept give37 do null; end give17;
or accept give38 do null; end give18;
or accept give39 do null; end give19;
or accept give40 do null; end give20;
or accept give41 do null; end give1;
or accept give42 do null; end give2;
or accept give43 do null; end give3;
or accept give44 do null; end give4;
or accept give45 do null; end give5;
or accept give46 do null; end give6;
or accept give47 do null; end give7;
or accept give48 do null; end give8;
or accept give49 do null; end give9;
or accept give50 do null; end give10;
or accept give51 do null; end give11;
or accept give52 do null; end give12;
or accept give53 do null; end give13;
or accept give54 do null; end give14;
or accept give55 do null; end give15;
or accept give56 do null; end give16;
or accept give57 do null; end give17;
or accept give58 do null; end give18;
or accept give59 do null; end give19;
or accept give60 do null; end give20;
or accept give61 do null; end give1;
or accept give62 do null; end give2;
or accept give63 do null; end give3;
or accept give64 do null; end give4;
or accept give65 do null; end give5;
or accept give66 do null; end give6;
or accept give67 do null; end give7;
or accept give68 do null; end give8;
or accept give69 do null; end give9;
or accept give70 do null; end give10;
or accept give71 do null; end give11;
or accept give72 do null; end give12;
or accept give73 do null; end give13;
or accept give74 do null; end give14;
or accept give75 do null; end give15;
or accept give76 do null; end give16;
or accept give77 do null; end give17;
or accept give78 do null; end give18;
or accept give79 do null; end give19;
or accept give80 do null; end give20;
or accept give81 do null; end give1;
or accept give82 do null; end give2;
or accept give83 do null; end give3;
or accept give84 do null; end give4;
or accept give85 do null; end give5;
or accept give86 do null; end give6;
or accept give87 do null; end give7;
or accept give88 do null; end give8;
or accept give89 do null; end give9;
or accept give90 do null; end give10;
or accept give91 do null; end give11;
or accept give92 do null; end give12;
or accept give93 do null; end give13;
or accept give94 do null; end give14;
or accept give95 do null; end give15;
or accept give96 do null; end give16;
or accept give97 do null; end give17;
or accept give98 do null; end give18;
or accept give99 do null; end give19;
or accept give100 do null; end give20;
end select;
end loop;
end link1;
begin
null;
end test;
**********************************************************************
* NEXT PROGRAM *
**********************************************************************
***** SCHEDTEST *****
-- schedtest : see if any tasks get starved
--
-- t1----------->slave<------------t3
-- t2----------->
--
-- t1 & t2 call entry1 in slave, t3 calls entry2
-- slave aborts after entered 1000 times
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
call1: integer;
call2: integer;
task slave is
entry entry1;
entry entry2;
end slave;
task t1 is end t1;
task t2 is end t2;
task t3 is end t3;
task body t3 is
begin
loop
if printon then put_line("t3"); end if;
slave.entry2;
end loop;
end t3;
task body slave is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
call1 := 0;
call2 := 0;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
select
accept entry1 do
call1 := call1 + 1;
if printon then put_line("slave entry1"); end if;
end entry1;
or
accept entry2 do
call2 := call2 + 1;
if printon then put_line("slave entry2"); end if;
end entry2;
end select;
end loop;
put_line("ended");
-- put("entry1=");
-- put(call1);
-- put(" entry2=");
-- put(call2);
end slave;
task body t1 is
begin
loop
if printon then put_line("t1"); end if;
slave.entry1;
end loop;
end t1;
task body t2 is
begin
loop
if printon then put_line("t2"); end if;
slave.entry1;
end loop;
end t2;
begin
null;
end test;
--::::::::::
--sritests.src
--::::::::::
--::::::::::
--sritests.dis
--::::::::::
--
-- The following is the introductory documentation
--
SRITESTS.DOC
--
-- The following are the benchmarks/tests
--
CHAIN2.ADA
CHAIN5.ADA
CHAIN10.ADA
CHAIN20.ADA
IDLE1.ADA
IDLE5.ADA
IDLE10.ADA
IDLE20.ADA
SELECT2.ADA
SELECT2E.ADA
SELECT20.ADA
SELECT20E.ADA
GUARD2.ADA
GUARD2E.ADA
GUARD20.ADA
GUARD20E.ADA
GUARD20T.ADA
GUARD20ET.ADA
CHAIN2N.ADA
CHAIN2PKT.ADA
CHAIN2PTR.ADA
PASSARRYS.ADA
PASSARRYB.ADA
PASSINOUT.ADA
MORETASKS.ADA
MORETASKSL.ADA
MORESELCT.ADA
MORESELCTR.ADA
ORDER31.ADA
ORDER31R.ADA
ORDER32.ADA
ORDER100.ADA
SCHEDTEST.ADA
--::::::::::
--SRITESTS.DOC
--::::::::::
PERFORMANCE TESTING OF SOME ADA PROGRAMMING CONTRUCTS
SRI is developing a packet switched network node, using the Ada
programming language, and using the SUN Microsystem processor board as
the target hardware, which contains a MC68000. We have run some timing
measurements on specially written Ada test programs in order to
determine how to optimally use tasking, rendevous, selects, and
parameter passing, and also to make an early prediction on the
packet-per-second throughput of the system.
The test were compiled with the Telesoft Ada Compiler on a Diskless SUN
Workstation, running UNIX 4.1c bsd. The workstation was configured
with 2 megabytes of local memory, and only a single user was logged in.
When the Run command is given to start the Ada program, it takes about
5 seconds for the run-time support environment to be loaded to the
diskless sun. Therefore timing is not started until a prompt from the
program is answered by the user with a carriage return. Timing is done
manually with a stopwatch. The program may optionally turn on
printing, to check for deadlock situations, by answering the promt with
a 'y' - this of course slows down the program, and these runs should
not be used for performance measuring.
Most of the timings for each program were repeated 5 times, and the
variance in time was seldom more than a second. Timings given are the
averages for multiple trials.
Following the times below is a summary of the program characteristics
and the conclusions drawn from the tests.
program cycles seconds
________________________________________
chain2 1000 3.57
chain5 1000 10.15
chain10 1000 19.66
chain20 1000 38.03
idle1 10000 29.46
idle5 -
idle10 -
idle20 10000 29.93
select2 1000 4.38
select2e 1000 4.38
select20 1000 8.42
select20e 1000 8.33
guard2 1000 4.28
guard2e 1000 4.22
guard20 1000 6.20
guard20e 1000 6.11
guard20t 1000 8.31
guard20et 1000 8.11
chain2n 10000 29.58
chain2pkt 10000 29.77
chain2ptr 10000 29.98
passarrys 10000 29.
passarryb 10000 29.
passinout 10000 29.
moretasks 1000 38.
moretasksl 1000 47.
moreselct 1000 128.
moreselctr 1000 130.
order31 100 28.
order31r 100 28.
order32 compiles without errors, but crashes when run
order100 compiles without errors, but crashes when run
DESCRIPTION OF TEST PROGRAMS AND RESULTS
CHAIN - TO DETERMINE OVERHEAD IN CONTEXTS SWITCHES BETWEEN TASKS
Each chain task, within each cycle of the loop, calls an entry in the
"next task" in a chain of tasks, the called entry contains a null
statement and returns, and the tasks then waits to be called by another
task at a similar entry of its own. Thus each task is run in turn
dependent on its position in the chain. Chains of length 2, 5, 10, and
20 tasks were compared after 1000 complete cycles around the chain.
Times recorded were
chain2 1000 3.57
chain5 1000 10.15
chain10 1000 19.66
chain20 1000 38.03
Dividing these times by the number of tasks in each test yields
respectively 1.78, 2.03, 1.96, and 1.90; dividing by the number of
cycles then indicates that each context switch (rendezvous) costs about
2 millisec.
IDLE - DETERMINE WHETHER IDLE TASKS IMPACT PERFORMANCE
A chain of length 2 as described above was cycled 10000 times, before
the cycles are started, some number of "idle" task are called at an
"init" entry and are then left waiting at a "never" entry which will
never be called. The timings for 1 and 20 idle task are recorded below
idle1 10000 29.46
idle5 -
idle10 -
idle20 10000 29.93
Within the accuracy of the measurements, there is no difference
in the timings, which implies that there is no performance penalty
for increasing numbers of tasks waiting on a single entrys.
SELECT - DOES THE NUMBER OF SELECT CHOICES MATTER
One task calls a single entry of a second task 1000 times, but
the second task has a select statement encompassing some
number of alternatives. The test was done for 2 and 20
alternatives, with the desired entry being the first one
in the select list, and repeated for the desired entry
being at the end of the select list.
select2 1000 4.38
select2e 1000 4.38
select20 1000 8.42
select20e 1000 8.33
These results show that large select statements are costly.
GUARDS - DO GUARDS ON ENTRY STATEMENTS IMPACT PERFORMANCE
The select tests above were repeated with boolean guards placed
in front of all the entry choices. In some cases, only the
guard on the entry which would really be called was true, and
all of the other guards were false. In other cases, all of the
guards were set to true.
guard2 1000 4.28
guard2e 1000 4.22
guard20 1000 6.20
guard20e 1000 6.11
guard20t 1000 8.31
guard20et 1000 8.11
Comparing these results with the previous tests, it appears that
the cost of using guards on select entrys is very small.
A guard which evaluates to false apparently significantly reduces the overhead
of evaluating the guarded select.
PARAMETERS - WHAT IS THE IMPACT OF PASSING PARAMETERS IN RENDEVOUS
The following chain test were run passing "no" parameters, passing
a packet record as a parameter, and passing a pointer to a record.
chain2n 10000 29.58
chain2pkt 10000 29.77
chain2ptr 10000 29.98
The results show the there is no measurable cost in using entry parameters.
PARAMETER SIZE - DOES SIZE OF THE PASSED PARAMETER MAKE A DIFFERENCE
The above test was repeated with a parameters as follows. A "in"
small integer array of length 2, an "in" integer array length 32000,
and an "in out" integer array length 32000.
passarrys 10000 29.
passarryb 10000 29.
passinout 10000 29.
There is no observed cost in using large structures as parameters.
TASKS - IS IT BETTER TO HAVE LOTS OF LITTLE TASKS WITH SINGLE ENTRY CHOICES
OR FEW BIG TASKS WITH MANY SELECT CHOICES
Some of the previous results would imply the use of many tasks.
In the "moretasks" tests, a master tasks calls each of 20 slave tasks,
each with a single entry. In "moretasksl" each task again has a single
entry, but it is embedded in a select statement for fair comparison
to the next test. In "moreselct" a master task calls each of the 20
entrys in a single slave task, and the slave task has the 20 entrys
embedded in a large select statement. In the "moreselctr" the 20
entrys are listed in the opposite order to which the master calls them.
moretasks 1000 38.
moretasksl 1000 47.
moreselct 1000 128.
moreselctr 1000 130.
The results suggest to use lots of tasks with few select choices.
ORDER - DOES ORDERING OF ENTRY CLAUSES IN A SELECT MATTER
The "moreselct" test was modified by increasing the number of
entry clauses to 100. However it was discovered that a
select statement can only contain a maximum of 31 choices.
Then the program was run for 100 cycles. Another test was
run calling the entrys in the reverse of the select statement.
order31 100 28.
order31r 100 28.
order32 compiles without errors, but crashes when run
order100 compiles without errors, but crashes when run
No difference was determined, however if a large select clause
were permitted (100 entries) it may have suggested which ordering
was optimal.
SCHEDTEST - DETERMINE WHETHER THE ADA SCHEDULER MAY STARVE A TASK
A slave task with a two entry select statement is used independently by
three other tasks. The test is run until the slave has been called
1000 times. Two of the tasks call the first entry, and the third task
calls the second slave entry. Each task, and the slave have print
statements to help determine which task is running. The order and
relative frequency of the tasks printout will show whether any of the
task are starved or run more often than the others. When the test was
run, it was seen that the three tasks alternately print their rendezous
annoucement once each. Thus, none of the tasks were starved, and
rescheduling apparently occurs with the frequency of one rendezous.
CONCLUSIONS
The overhead of a rendevous or task context switch takes 1 - 2 millisecs.
The number of idle tasks waiting on uncalled entries, do not impact speed.
The number of entrys in a select significantly impacts selection speed.
Evaluation of "when" clauses is quick, and when false, prevent the
long select evaluation time, speeding the system.
Passing parameters in rendezous is quick, and there is not much difference
on parameter size or whether "in" or "in out".
The ordering of entrys in a select clause in not important.
To build an optimized system, use more tasks, each with less number
of entries in select clauses, and use guards.
CAUTIONS
Array index are apparently limited to 32000 elements.
Selects may have no more than 31 possible entries.
TELESOFT COMPILER LIMITATIONS
The Telesoft Ada Compiler that we have used for performing these
benchmarks is not a complete implementation of the language. Telesoft
is currently in the process of validating their full Ada compiler, and
we will then get an update with the full language implemented. Some of
the deficiencies of the language, which affected our selection of
benchmarks and programming style, are generics, subunits, some pragmas,
representation specifications, tasks types, entry families, timed entry
calls and the calendar package, and the abort statement.
SUGGESTIONS FOR FURTHER ADA BENCHMARK STUDIES
Most of the test which we performed were concerned with determining how
to optimize task and select statement organization. However, it is
important to understand many of the other facilites of the rich
language, some of which are not yet implemented in our compiler.
Particularly in our application of a real time packet switching node,
we should study the performance of representation specifications, low
level input/output, the timing facilities, aborts, and interrupt
handling.
--::::::::::
--CHAIN2.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** CHAIN2 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
--::::::::::
--CHAIN5.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** CHAIN5 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link2 is
entry give;
end link2;
task link3 is
entry give;
end link3;
task link4 is
entry give;
end link4;
task link5 is
entry give;
end link5;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link2.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link2 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link2"); end if;
link3.give;
end loop;
end link2;
task body link3 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link3"); end if;
link4.give;
end loop;
end link3;
task body link4 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link4"); end if;
link5.give;
end loop;
end link4;
task body link5 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link5"); end if;
head.give;
end loop;
end link5;
begin
null;
end test;
--::::::::::
--CHAIN10.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** CHAIN10 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link2 is
entry give;
end link2;
task link3 is
entry give;
end link3;
task link4 is
entry give;
end link4;
task link5 is
entry give;
end link5;
task link11 is
entry give;
end link11;
task link12 is
entry give;
end link12;
task link13 is
entry give;
end link13;
task link14 is
entry give;
end link14;
task link15 is
entry give;
end link15;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link2.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link2 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link2"); end if;
link3.give;
end loop;
end link2;
task body link3 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link3"); end if;
link4.give;
end loop;
end link3;
task body link4 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link4"); end if;
link5.give;
end loop;
end link4;
task body link5 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link5"); end if;
link11.give;
end loop;
end link5;
task body link11 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link11"); end if;
link12.give;
end loop;
end link11;
task body link12 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link12"); end if;
link13.give;
end loop;
end link12;
task body link13 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link13"); end if;
link14.give;
end loop;
end link13;
task body link14 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link14"); end if;
link15.give;
end loop;
end link14;
task body link15 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link15"); end if;
head.give;
end loop;
end link15;
begin
null;
end test;
--::::::::::
--CHAIN20.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** CHAIN20 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link2 is
entry give;
end link2;
task link3 is
entry give;
end link3;
task link4 is
entry give;
end link4;
task link5 is
entry give;
end link5;
task link11 is
entry give;
end link11;
task link12 is
entry give;
end link12;
task link13 is
entry give;
end link13;
task link14 is
entry give;
end link14;
task link15 is
entry give;
end link15;
task link21 is
entry give;
end link21;
task link22 is
entry give;
end link22;
task link23 is
entry give;
end link23;
task link24 is
entry give;
end link24;
task link25 is
entry give;
end link25;
task link211 is
entry give;
end link211;
task link212 is
entry give;
end link212;
task link213 is
entry give;
end link213;
task link214 is
entry give;
end link214;
task link215 is
entry give;
end link215;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link2.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link2 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link2"); end if;
link3.give;
end loop;
end link2;
task body link3 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link3"); end if;
link4.give;
end loop;
end link3;
task body link4 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link4"); end if;
link5.give;
end loop;
end link4;
task body link5 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link5"); end if;
link11.give;
end loop;
end link5;
task body link11 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link11"); end if;
link12.give;
end loop;
end link11;
task body link12 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link12"); end if;
link13.give;
end loop;
end link12;
task body link13 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link13"); end if;
link14.give;
end loop;
end link13;
task body link14 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link14"); end if;
link15.give;
end loop;
end link14;
task body link15 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link15"); end if;
link21.give;
end loop;
end link15;
task body link21 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link21"); end if;
link22.give;
end loop;
end link21;
task body link22 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link22"); end if;
link23.give;
end loop;
end link22;
task body link23 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link23"); end if;
link24.give;
end loop;
end link23;
task body link24 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link24"); end if;
link25.give;
end loop;
end link24;
task body link25 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link25"); end if;
link211.give;
end loop;
end link25;
task body link211 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link211"); end if;
link212.give;
end loop;
end link211;
task body link212 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link212"); end if;
link213.give;
end loop;
end link212;
task body link213 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link213"); end if;
link214.give;
end loop;
end link213;
task body link214 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link214"); end if;
link215.give;
end loop;
end link214;
task body link215 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link215"); end if;
head.give;
end loop;
end link215;
begin
null;
end test;
--::::::::::
--IDLE1.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** IDLE1 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
end link1;
task idle1 is
entry init;
entry never;
end idle1;
task body head is
begin
idle1.init;
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
task body idle1 is
begin
accept init do put_line("idle1"); end init;
accept never do null; end never;
end idle1;
begin
null;
end test;
--::::::::::
--IDLE5.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** IDLE5 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
end link1;
task idle1 is
entry init;
entry never;
end idle1;
task idle2 is
entry init;
entry never;
end idle2;
task idle3 is
entry init;
entry never;
end idle3;
task idle4 is
entry init;
entry never;
end idle4;
task idle5 is
entry init;
entry never;
end idle5;
task body head is
begin
idle1.init;
idle2.init;
idle3.init;
idle4.init;
idle5.init;
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
task body idle1 is
begin
accept init do put_line("idle1"); end init;
accept never do null; end never;
end idle1;
task body idle2 is
begin
accept init do put_line("idle2"); end init;
accept never do null; end never;
end idle2;
task body idle3 is
begin
accept init do put_line("idle3"); end init;
accept never do null; end never;
end idle3;
task body idle4 is
begin
accept init do put_line("idle4"); end init;
accept never do null; end never;
end idle4;
task body idle5 is
begin
accept init do put_line("idle5"); end init;
accept never do null; end never;
end idle5;
begin
null;
end test;
--::::::::::
--IDLE10.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** IDLE10 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
end link1;
task idle1 is
entry init;
entry never;
end idle1;
task idle2 is
entry init;
entry never;
end idle2;
task idle3 is
entry init;
entry never;
end idle3;
task idle4 is
entry init;
entry never;
end idle4;
task idle5 is
entry init;
entry never;
end idle5;
task idle11 is
entry init;
entry never;
end idle11;
task idle12 is
entry init;
entry never;
end idle12;
task idle13 is
entry init;
entry never;
end idle13;
task idle14 is
entry init;
entry never;
end idle14;
task idle15 is
entry init;
entry never;
end idle15;
task body head is
begin
idle1.init;
idle2.init;
idle3.init;
idle4.init;
idle5.init;
idle11.init;
idle12.init;
idle13.init;
idle14.init;
idle15.init;
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
task body idle1 is
begin
accept init do put_line("idle1"); end init;
accept never do null; end never;
end idle1;
task body idle2 is
begin
accept init do put_line("idle2"); end init;
accept never do null; end never;
end idle2;
task body idle3 is
begin
accept init do put_line("idle3"); end init;
accept never do null; end never;
end idle3;
task body idle4 is
begin
accept init do put_line("idle4"); end init;
accept never do null; end never;
end idle4;
task body idle5 is
begin
accept init do put_line("idle5"); end init;
accept never do null; end never;
end idle5;
task body idle11 is
begin
accept init do put_line("idle11"); end init;
accept never do null; end never;
end idle11;
task body idle12 is
begin
accept init do put_line("idle12"); end init;
accept never do null; end never;
end idle12;
task body idle13 is
begin
accept init do put_line("idle13"); end init;
accept never do null; end never;
end idle13;
task body idle14 is
begin
accept init do put_line("idle14"); end init;
accept never do null; end never;
end idle14;
task body idle15 is
begin
accept init do put_line("idle15"); end init;
accept never do null; end never;
end idle15;
begin
null;
end test;
--::::::::::
--IDLE20.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** IDLE20 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
end link1;
task idle1 is
entry init;
entry never;
end idle1;
task idle2 is
entry init;
entry never;
end idle2;
task idle3 is
entry init;
entry never;
end idle3;
task idle4 is
entry init;
entry never;
end idle4;
task idle5 is
entry init;
entry never;
end idle5;
task idle11 is
entry init;
entry never;
end idle11;
task idle12 is
entry init;
entry never;
end idle12;
task idle13 is
entry init;
entry never;
end idle13;
task idle14 is
entry init;
entry never;
end idle14;
task idle15 is
entry init;
entry never;
end idle15;
task idle21 is
entry init;
entry never;
end idle21;
task idle22 is
entry init;
entry never;
end idle22;
task idle23 is
entry init;
entry never;
end idle23;
task idle24 is
entry init;
entry never;
end idle24;
task idle25 is
entry init;
entry never;
end idle25;
task idle211 is
entry init;
entry never;
end idle211;
task idle212 is
entry init;
entry never;
end idle212;
task idle213 is
entry init;
entry never;
end idle213;
task idle214 is
entry init;
entry never;
end idle214;
task idle215 is
entry init;
entry never;
end idle215;
task body head is
begin
idle1.init;
idle2.init;
idle3.init;
idle4.init;
idle5.init;
idle11.init;
idle12.init;
idle13.init;
idle14.init;
idle15.init;
idle21.init;
idle22.init;
idle23.init;
idle24.init;
idle25.init;
idle211.init;
idle212.init;
idle213.init;
idle214.init;
idle215.init;
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
task body idle1 is
begin
accept init do put_line("idle1"); end init;
accept never do null; end never;
end idle1;
task body idle2 is
begin
accept init do put_line("idle2"); end init;
accept never do null; end never;
end idle2;
task body idle3 is
begin
accept init do put_line("idle3"); end init;
accept never do null; end never;
end idle3;
task body idle4 is
begin
accept init do put_line("idle4"); end init;
accept never do null; end never;
end idle4;
task body idle5 is
begin
accept init do put_line("idle5"); end init;
accept never do null; end never;
end idle5;
task body idle11 is
begin
accept init do put_line("idle11"); end init;
accept never do null; end never;
end idle11;
task body idle12 is
begin
accept init do put_line("idle12"); end init;
accept never do null; end never;
end idle12;
task body idle13 is
begin
accept init do put_line("idle13"); end init;
accept never do null; end never;
end idle13;
task body idle14 is
begin
accept init do put_line("idle14"); end init;
accept never do null; end never;
end idle14;
task body idle15 is
begin
accept init do put_line("idle15"); end init;
accept never do null; end never;
end idle15;
task body idle21 is
begin
accept init do put_line("idle21"); end init;
accept never do null; end never;
end idle21;
task body idle22 is
begin
accept init do put_line("idle22"); end init;
accept never do null; end never;
end idle22;
task body idle23 is
begin
accept init do put_line("idle23"); end init;
accept never do null; end never;
end idle23;
task body idle24 is
begin
accept init do put_line("idle24"); end init;
accept never do null; end never;
end idle24;
task body idle25 is
begin
accept init do put_line("idle25"); end init;
accept never do null; end never;
end idle25;
task body idle211 is
begin
accept init do put_line("idle211"); end init;
accept never do null; end never;
end idle211;
task body idle212 is
begin
accept init do put_line("idle212"); end init;
accept never do null; end never;
end idle212;
task body idle213 is
begin
accept init do put_line("idle213"); end init;
accept never do null; end never;
end idle213;
task body idle214 is
begin
accept init do put_line("idle214"); end init;
accept never do null; end never;
end idle214;
task body idle215 is
begin
accept init do put_line("idle215"); end init;
accept never do null; end never;
end idle215;
begin
null;
end test;
--::::::::::
--SELECT2.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** SELECT2 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept give do
null;
end give;
or accept s2 do null; end s2;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
--::::::::::
--SELECT2E.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** SELECT2E *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept s2 do null; end s2;
or accept give do
null;
end give;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
--::::::::::
--SELECT20.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** SELECT20 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
entry s3;
entry s4;
entry s5;
entry s6;
entry s7;
entry s8;
entry s9;
entry s10;
entry s11;
entry s12;
entry s13;
entry s14;
entry s15;
entry s16;
entry s17;
entry s18;
entry s19;
entry s20;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept give do
null;
end give;
or accept s2 do null; end s2;
or accept s3 do null; end s3;
or accept s4 do null; end s4;
or accept s5 do null; end s5;
or accept s6 do null; end s6;
or accept s7 do null; end s7;
or accept s8 do null; end s8;
or accept s9 do null; end s9;
or accept s10 do null; end s10;
or accept s11 do null; end s11;
or accept s12 do null; end s12;
or accept s13 do null; end s13;
or accept s14 do null; end s14;
or accept s15 do null; end s15;
or accept s16 do null; end s16;
or accept s17 do null; end s17;
or accept s18 do null; end s18;
or accept s19 do null; end s19;
or accept s20 do null; end s20;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
--::::::::::
--SELECT20E.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** SELECT20E *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
entry s3;
entry s4;
entry s5;
entry s6;
entry s7;
entry s8;
entry s9;
entry s10;
entry s11;
entry s12;
entry s13;
entry s14;
entry s15;
entry s16;
entry s17;
entry s18;
entry s19;
entry s20;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept s2 do null; end s2;
or accept s3 do null; end s3;
or accept s4 do null; end s4;
or accept s5 do null; end s5;
or accept s6 do null; end s6;
or accept s7 do null; end s7;
or accept s8 do null; end s8;
or accept s9 do null; end s9;
or accept s10 do null; end s10;
or accept s11 do null; end s11;
or accept s12 do null; end s12;
or accept s13 do null; end s13;
or accept s14 do null; end s14;
or accept s15 do null; end s15;
or accept s16 do null; end s16;
or accept s17 do null; end s17;
or accept s18 do null; end s18;
or accept s19 do null; end s19;
or accept s20 do null; end s20;
or accept give do
null;
end give;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
--::::::::::
--GUARD2.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** GUARD2 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
g1: boolean := true;
g2: boolean := false;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
when g1 => accept give do null; end give;
or when g2 => accept s2 do null; end s2;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
--::::::::::
--GUARD2E.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** GUARD2E *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
g1: boolean := true;
g2: boolean := false;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
when g2 => accept s2 do null; end s2;
or when g1 => accept give do null; end give;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
--::::::::::
--GUARD20.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** GUARD20 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
g1: boolean := true;
g2: boolean := false;
g3: boolean := false;
g4: boolean := false;
g5: boolean := false;
g6: boolean := false;
g7: boolean := false;
g8: boolean := false;
g9: boolean := false;
g10: boolean := false;
g11: boolean := false;
g12: boolean := false;
g13: boolean := false;
g14: boolean := false;
g15: boolean := false;
g16: boolean := false;
g17: boolean := false;
g18: boolean := false;
g19: boolean := false;
g20: boolean := false;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
entry s3;
entry s4;
entry s5;
entry s6;
entry s7;
entry s8;
entry s9;
entry s10;
entry s11;
entry s12;
entry s13;
entry s14;
entry s15;
entry s16;
entry s17;
entry s18;
entry s19;
entry s20;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
when g1 => accept give do null; end give;
or when g2 => accept s2 do null; end s2;
or when g3 => accept s3 do null; end s3;
or when g4 => accept s4 do null; end s4;
or when g5 => accept s5 do null; end s5;
or when g6 => accept s6 do null; end s6;
or when g7 => accept s7 do null; end s7;
or when g8 => accept s8 do null; end s8;
or when g9 => accept s9 do null; end s9;
or when g10 => accept s10 do null; end s10;
or when g11 => accept s11 do null; end s11;
or when g12 => accept s12 do null; end s12;
or when g13 => accept s13 do null; end s13;
or when g14 => accept s14 do null; end s14;
or when g15 => accept s15 do null; end s15;
or when g16 => accept s16 do null; end s16;
or when g17 => accept s17 do null; end s17;
or when g18 => accept s18 do null; end s18;
or when g19 => accept s19 do null; end s19;
or when g20 => accept s20 do null; end s20;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
--::::::::::
--GUARD20E.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** GUARD20E *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
g1: boolean := true;
g2: boolean := false;
g3: boolean := false;
g4: boolean := false;
g5: boolean := false;
g6: boolean := false;
g7: boolean := false;
g8: boolean := false;
g9: boolean := false;
g10: boolean := false;
g11: boolean := false;
g12: boolean := false;
g13: boolean := false;
g14: boolean := false;
g15: boolean := false;
g16: boolean := false;
g17: boolean := false;
g18: boolean := false;
g19: boolean := false;
g20: boolean := false;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
entry s3;
entry s4;
entry s5;
entry s6;
entry s7;
entry s8;
entry s9;
entry s10;
entry s11;
entry s12;
entry s13;
entry s14;
entry s15;
entry s16;
entry s17;
entry s18;
entry s19;
entry s20;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
when g2 => accept s2 do null; end s2;
or when g3 => accept s3 do null; end s3;
or when g4 => accept s4 do null; end s4;
or when g5 => accept s5 do null; end s5;
or when g6 => accept s6 do null; end s6;
or when g7 => accept s7 do null; end s7;
or when g8 => accept s8 do null; end s8;
or when g9 => accept s9 do null; end s9;
or when g10 => accept s10 do null; end s10;
or when g11 => accept s11 do null; end s11;
or when g12 => accept s12 do null; end s12;
or when g13 => accept s13 do null; end s13;
or when g14 => accept s14 do null; end s14;
or when g15 => accept s15 do null; end s15;
or when g16 => accept s16 do null; end s16;
or when g17 => accept s17 do null; end s17;
or when g18 => accept s18 do null; end s18;
or when g19 => accept s19 do null; end s19;
or when g20 => accept s20 do null; end s20;
or when g1 => accept give do null; end give;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
--::::::::::
--GUARD20T.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** GUARD20T *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
g1: boolean := true;
g2: boolean := true;
g3: boolean := true;
g4: boolean := true;
g5: boolean := true;
g6: boolean := true;
g7: boolean := true;
g8: boolean := true;
g9: boolean := true;
g10: boolean := true;
g11: boolean := true;
g12: boolean := true;
g13: boolean := true;
g14: boolean := true;
g15: boolean := true;
g16: boolean := true;
g17: boolean := true;
g18: boolean := true;
g19: boolean := true;
g20: boolean := true;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
entry s3;
entry s4;
entry s5;
entry s6;
entry s7;
entry s8;
entry s9;
entry s10;
entry s11;
entry s12;
entry s13;
entry s14;
entry s15;
entry s16;
entry s17;
entry s18;
entry s19;
entry s20;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
when g1 => accept give do null; end give;
or when g2 => accept s2 do null; end s2;
or when g3 => accept s3 do null; end s3;
or when g4 => accept s4 do null; end s4;
or when g5 => accept s5 do null; end s5;
or when g6 => accept s6 do null; end s6;
or when g7 => accept s7 do null; end s7;
or when g8 => accept s8 do null; end s8;
or when g9 => accept s9 do null; end s9;
or when g10 => accept s10 do null; end s10;
or when g11 => accept s11 do null; end s11;
or when g12 => accept s12 do null; end s12;
or when g13 => accept s13 do null; end s13;
or when g14 => accept s14 do null; end s14;
or when g15 => accept s15 do null; end s15;
or when g16 => accept s16 do null; end s16;
or when g17 => accept s17 do null; end s17;
or when g18 => accept s18 do null; end s18;
or when g19 => accept s19 do null; end s19;
or when g20 => accept s20 do null; end s20;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
--::::::::::
--GUARD20ET.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** GUARD20ET *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
g1: boolean := true;
g2: boolean := true;
g3: boolean := true;
g4: boolean := true;
g5: boolean := true;
g6: boolean := true;
g7: boolean := true;
g8: boolean := true;
g9: boolean := true;
g10: boolean := true;
g11: boolean := true;
g12: boolean := true;
g13: boolean := true;
g14: boolean := true;
g15: boolean := true;
g16: boolean := true;
g17: boolean := true;
g18: boolean := true;
g19: boolean := true;
g20: boolean := true;
task head is
entry give;
end head;
task link1 is
entry give;
entry s2;
entry s3;
entry s4;
entry s5;
entry s6;
entry s7;
entry s8;
entry s9;
entry s10;
entry s11;
entry s12;
entry s13;
entry s14;
entry s15;
entry s16;
entry s17;
entry s18;
entry s19;
entry s20;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
when g2 => accept s2 do null; end s2;
or when g3 => accept s3 do null; end s3;
or when g4 => accept s4 do null; end s4;
or when g5 => accept s5 do null; end s5;
or when g6 => accept s6 do null; end s6;
or when g7 => accept s7 do null; end s7;
or when g8 => accept s8 do null; end s8;
or when g9 => accept s9 do null; end s9;
or when g10 => accept s10 do null; end s10;
or when g11 => accept s11 do null; end s11;
or when g12 => accept s12 do null; end s12;
or when g13 => accept s13 do null; end s13;
or when g14 => accept s14 do null; end s14;
or when g15 => accept s15 do null; end s15;
or when g16 => accept s16 do null; end s16;
or when g17 => accept s17 do null; end s17;
or when g18 => accept s18 do null; end s18;
or when g19 => accept s19 do null; end s19;
or when g20 => accept s20 do null; end s20;
or when g1 => accept give do null; end give;
end select;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
--::::::::::
--CHAIN2N.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** CHAIN2N *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head is
entry give;
end head;
task link1 is
entry give;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
accept give do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
accept give do
null;
end give;
if printon then put_line("link1"); end if;
head.give;
end loop;
end link1;
begin
null;
end test;
--::::::::::
--CHAIN2PKT.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** CHAIN2PKT *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
type vector is array(integer range <>) of integer;
type pkt_type;
type pkt_ptr is access pkt_type;
type pkt_type is record
next: pkt_ptr;
header: vector(1..25);
data: string(1..50);
tailer: vector(1..25);
end record;
task head is
entry give(p:in pkt_type);
end head;
task link1 is
entry give(p:in pkt_type);
end link1;
task body head is
pkt : pkt_type;
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give(pkt);
accept give(p:in pkt_type) do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
pkt: pkt_type;
begin
loop
accept give(p:in pkt_type) do
null;
end give;
if printon then put_line("link1"); end if;
head.give(pkt);
end loop;
end link1;
begin
null;
end test;
--::::::::::
--CHAIN2PTR.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** CHAIN2PTR *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
type vector is array(integer range <>) of integer;
type pkt_type;
type pkt_ptr is access pkt_type;
type pkt_type is record
next: pkt_ptr;
header: vector(1..25);
data: string(1..50);
tailer: vector(1..25);
end record;
task head is
entry give(p:in pkt_ptr);
end head;
task link1 is
entry give(p:in pkt_ptr);
end link1;
task body head is
pkt : pkt_ptr;
begin
pkt := new pkt_type;
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give(pkt);
accept give(p:in pkt_ptr) do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
pkt: pkt_ptr;
begin
pkt := new pkt_type;
loop
accept give(p:in pkt_ptr) do
null;
end give;
if printon then put_line("link1"); end if;
head.give(pkt);
end loop;
end link1;
begin
null;
end test;
--::::::::::
--PASSARRYS.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** PASSARRYS *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
type param_type is array(1..2) of character;
task head is
entry give(p:in param_type);
end head;
task link1 is
entry give(p:in param_type);
end link1;
task body head is
p : param_type;
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give(p);
accept give(p:in param_type) do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
p: param_type;
begin
loop
accept give(p:in param_type) do
null;
end give;
if printon then put_line("link1"); end if;
head.give(p);
end loop;
end link1;
begin
null;
end test;
--::::::::::
--PASSARRYB.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** PASSARRYB *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
-- 32000 is biggest char arry legal
type param_type is array(1..32000) of integer;
task head is
entry give(p:in param_type);
end head;
task link1 is
entry give(p:in param_type);
end link1;
task body head is
p : param_type;
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give(p);
accept give(p:in param_type) do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
p: param_type;
begin
loop
accept give(p:in param_type) do
null;
end give;
if printon then put_line("link1"); end if;
head.give(p);
end loop;
end link1;
begin
null;
end test;
--::::::::::
--PASSINOUT.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** PASSINOUT *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
-- 32000 is biggest char arry legal
type param_type is array(1..32000) of integer;
task head is
entry give(p:in out param_type);
end head;
task link1 is
entry give(p:in out param_type);
end link1;
task body head is
p : param_type;
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 10000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give(p);
accept give(p:in out param_type) do
null;
end give;
end loop;
put_line("ended");
end head;
task body link1 is
p: param_type;
begin
loop
accept give(p:in out param_type) do
null;
end give;
if printon then put_line("link1"); end if;
head.give(p);
end loop;
end link1;
begin
null;
end test;
--::::::::::
--MORETASKS.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** MORETASKS *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head;
task link1 is
entry give;
end link1;
task link2 is
entry give;
end link2;
task link3 is
entry give;
end link3;
task link4 is
entry give;
end link4;
task link5 is
entry give;
end link5;
task link6 is
entry give;
end link6;
task link7 is
entry give;
end link7;
task link8 is
entry give;
end link8;
task link9 is
entry give;
end link9;
task link10 is
entry give;
end link10;
task link11 is
entry give;
end link11;
task link12 is
entry give;
end link12;
task link13 is
entry give;
end link13;
task link14 is
entry give;
end link14;
task link15 is
entry give;
end link15;
task link16 is
entry give;
end link16;
task link17 is
entry give;
end link17;
task link18 is
entry give;
end link18;
task link19 is
entry give;
end link19;
task link20 is
entry give;
end link20;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
link2.give;
link3.give;
link4.give;
link5.give;
link6.give;
link7.give;
link8.give;
link9.give;
link10.give;
link11.give;
link12.give;
link13.give;
link14.give;
link15.give;
link16.give;
link17.give;
link18.give;
link19.give;
link20.give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
accept give do
null;
end give;
end loop;
end link1;
task body link2 is
begin
loop
accept give do
null;
end give;
end loop;
end link2;
task body link3 is
begin
loop
accept give do
null;
end give;
end loop;
end link3;
task body link4 is
begin
loop
accept give do
null;
end give;
end loop;
end link4;
task body link5 is
begin
loop
accept give do
null;
end give;
end loop;
end link5;
task body link6 is
begin
loop
accept give do
null;
end give;
end loop;
end link6;
task body link7 is
begin
loop
accept give do
null;
end give;
end loop;
end link7;
task body link8 is
begin
loop
accept give do
null;
end give;
end loop;
end link8;
task body link9 is
begin
loop
accept give do
null;
end give;
end loop;
end link9;
task body link10 is
begin
loop
accept give do
null;
end give;
end loop;
end link10;
task body link11 is
begin
loop
accept give do
null;
end give;
end loop;
end link11;
task body link12 is
begin
loop
accept give do
null;
end give;
end loop;
end link12;
task body link13 is
begin
loop
accept give do
null;
end give;
end loop;
end link13;
task body link14 is
begin
loop
accept give do
null;
end give;
end loop;
end link14;
task body link15 is
begin
loop
accept give do
null;
end give;
end loop;
end link15;
task body link16 is
begin
loop
accept give do
null;
end give;
end loop;
end link16;
task body link17 is
begin
loop
accept give do
null;
end give;
end loop;
end link17;
task body link18 is
begin
loop
accept give do
null;
end give;
end loop;
end link18;
task body link19 is
begin
loop
accept give do
null;
end give;
end loop;
end link19;
task body link20 is
begin
loop
accept give do
null;
end give;
end loop;
end link20;
begin
null;
end test;
--::::::::::
--MORETASKSL.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** MORETASKSL *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head;
task link1 is
entry give;
end link1;
task link2 is
entry give;
end link2;
task link3 is
entry give;
end link3;
task link4 is
entry give;
end link4;
task link5 is
entry give;
end link5;
task link6 is
entry give;
end link6;
task link7 is
entry give;
end link7;
task link8 is
entry give;
end link8;
task link9 is
entry give;
end link9;
task link10 is
entry give;
end link10;
task link11 is
entry give;
end link11;
task link12 is
entry give;
end link12;
task link13 is
entry give;
end link13;
task link14 is
entry give;
end link14;
task link15 is
entry give;
end link15;
task link16 is
entry give;
end link16;
task link17 is
entry give;
end link17;
task link18 is
entry give;
end link18;
task link19 is
entry give;
end link19;
task link20 is
entry give;
end link20;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give;
link2.give;
link3.give;
link4.give;
link5.give;
link6.give;
link7.give;
link8.give;
link9.give;
link10.give;
link11.give;
link12.give;
link13.give;
link14.give;
link15.give;
link16.give;
link17.give;
link18.give;
link19.give;
link20.give;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link1;
task body link2 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link2;
task body link3 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link3;
task body link4 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link4;
task body link5 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link5;
task body link6 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link6;
task body link7 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link7;
task body link8 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link8;
task body link9 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link9;
task body link10 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link10;
task body link11 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link11;
task body link12 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link12;
task body link13 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link13;
task body link14 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link14;
task body link15 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link15;
task body link16 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link16;
task body link17 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link17;
task body link18 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link18;
task body link19 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link19;
task body link20 is
begin
loop
select accept give do null; end give; end select;
end loop;
end link20;
begin
null;
end test;
--::::::::::
--MORESELCT.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** MORESELCT *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head;
task link1 is
entry give1;
entry give2;
entry give3;
entry give4;
entry give5;
entry give6;
entry give7;
entry give8;
entry give9;
entry give10;
entry give11;
entry give12;
entry give13;
entry give14;
entry give15;
entry give16;
entry give17;
entry give18;
entry give19;
entry give20;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give1;
link1.give2;
link1.give3;
link1.give4;
link1.give5;
link1.give6;
link1.give7;
link1.give8;
link1.give9;
link1.give10;
link1.give11;
link1.give12;
link1.give13;
link1.give14;
link1.give15;
link1.give16;
link1.give17;
link1.give18;
link1.give19;
link1.give20;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept give1 do null; end give1;
or accept give2 do null; end give2;
or accept give3 do null; end give3;
or accept give4 do null; end give4;
or accept give5 do null; end give5;
or accept give6 do null; end give6;
or accept give7 do null; end give7;
or accept give8 do null; end give8;
or accept give9 do null; end give9;
or accept give10 do null; end give10;
or accept give11 do null; end give11;
or accept give12 do null; end give12;
or accept give13 do null; end give13;
or accept give14 do null; end give14;
or accept give15 do null; end give15;
or accept give16 do null; end give16;
or accept give17 do null; end give17;
or accept give18 do null; end give18;
or accept give19 do null; end give19;
or accept give20 do null; end give20;
end select;
end loop;
end link1;
begin
null;
end test;
--::::::::::
--MORESELCTR.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** MORESELCTR *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head;
task link1 is
entry give1;
entry give2;
entry give3;
entry give4;
entry give5;
entry give6;
entry give7;
entry give8;
entry give9;
entry give10;
entry give11;
entry give12;
entry give13;
entry give14;
entry give15;
entry give16;
entry give17;
entry give18;
entry give19;
entry give20;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give1;
link1.give2;
link1.give3;
link1.give4;
link1.give5;
link1.give6;
link1.give7;
link1.give8;
link1.give9;
link1.give10;
link1.give11;
link1.give12;
link1.give13;
link1.give14;
link1.give15;
link1.give16;
link1.give17;
link1.give18;
link1.give19;
link1.give20;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept give20 do null; end give20;
or accept give19 do null; end give19;
or accept give18 do null; end give18;
or accept give17 do null; end give17;
or accept give16 do null; end give16;
or accept give15 do null; end give15;
or accept give14 do null; end give14;
or accept give13 do null; end give13;
or accept give12 do null; end give12;
or accept give11 do null; end give11;
or accept give10 do null; end give10;
or accept give9 do null; end give9;
or accept give8 do null; end give8;
or accept give7 do null; end give7;
or accept give6 do null; end give6;
or accept give5 do null; end give5;
or accept give4 do null; end give4;
or accept give3 do null; end give3;
or accept give2 do null; end give2;
or accept give1 do null; end give1;
end select;
end loop;
end link1;
begin
null;
end test;
--::::::::::
--ORDER31.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** ORDER31 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head;
task link1 is
entry give1;
entry give2;
entry give3;
entry give4;
entry give5;
entry give6;
entry give7;
entry give8;
entry give9;
entry give10;
entry give11;
entry give12;
entry give13;
entry give14;
entry give15;
entry give16;
entry give17;
entry give18;
entry give19;
entry give20;
entry give21;
entry give22;
entry give23;
entry give24;
entry give25;
entry give26;
entry give27;
entry give28;
entry give29;
entry give30;
entry give31;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 100;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give1;
link1.give2;
link1.give3;
link1.give4;
link1.give5;
link1.give6;
link1.give7;
link1.give8;
link1.give9;
link1.give10;
link1.give11;
link1.give12;
link1.give13;
link1.give14;
link1.give15;
link1.give16;
link1.give17;
link1.give18;
link1.give19;
link1.give20;
link1.give21;
link1.give22;
link1.give23;
link1.give24;
link1.give25;
link1.give26;
link1.give27;
link1.give28;
link1.give29;
link1.give30;
link1.give31;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept give1 do null; end give1;
or accept give2 do null; end give2;
or accept give3 do null; end give3;
or accept give4 do null; end give4;
or accept give5 do null; end give5;
or accept give6 do null; end give6;
or accept give7 do null; end give7;
or accept give8 do null; end give8;
or accept give9 do null; end give9;
or accept give10 do null; end give10;
or accept give11 do null; end give11;
or accept give12 do null; end give12;
or accept give13 do null; end give13;
or accept give14 do null; end give14;
or accept give15 do null; end give15;
or accept give16 do null; end give16;
or accept give17 do null; end give17;
or accept give18 do null; end give18;
or accept give19 do null; end give19;
or accept give20 do null; end give20;
or accept give21 do null; end give1;
or accept give22 do null; end give2;
or accept give23 do null; end give3;
or accept give24 do null; end give4;
or accept give25 do null; end give5;
or accept give26 do null; end give6;
or accept give27 do null; end give7;
or accept give28 do null; end give8;
or accept give29 do null; end give9;
or accept give30 do null; end give10;
or accept give31 do null; end give11;
end select;
end loop;
end link1;
begin
null;
end test;
--::::::::::
--ORDER31R.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** ORDER31R *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head;
task link1 is
entry give1;
entry give2;
entry give3;
entry give4;
entry give5;
entry give6;
entry give7;
entry give8;
entry give9;
entry give10;
entry give11;
entry give12;
entry give13;
entry give14;
entry give15;
entry give16;
entry give17;
entry give18;
entry give19;
entry give20;
entry give21;
entry give22;
entry give23;
entry give24;
entry give25;
entry give26;
entry give27;
entry give28;
entry give29;
entry give30;
entry give31;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 100;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give31;
link1.give30;
link1.give29;
link1.give28;
link1.give27;
link1.give26;
link1.give25;
link1.give24;
link1.give23;
link1.give22;
link1.give21;
link1.give20;
link1.give19;
link1.give18;
link1.give17;
link1.give16;
link1.give15;
link1.give14;
link1.give13;
link1.give12;
link1.give11;
link1.give10;
link1.give9;
link1.give8;
link1.give7;
link1.give6;
link1.give5;
link1.give4;
link1.give3;
link1.give2;
link1.give1;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept give1 do null; end give1;
or accept give2 do null; end give2;
or accept give3 do null; end give3;
or accept give4 do null; end give4;
or accept give5 do null; end give5;
or accept give6 do null; end give6;
or accept give7 do null; end give7;
or accept give8 do null; end give8;
or accept give9 do null; end give9;
or accept give10 do null; end give10;
or accept give11 do null; end give11;
or accept give12 do null; end give12;
or accept give13 do null; end give13;
or accept give14 do null; end give14;
or accept give15 do null; end give15;
or accept give16 do null; end give16;
or accept give17 do null; end give17;
or accept give18 do null; end give18;
or accept give19 do null; end give19;
or accept give20 do null; end give20;
or accept give21 do null; end give1;
or accept give22 do null; end give2;
or accept give23 do null; end give3;
or accept give24 do null; end give4;
or accept give25 do null; end give5;
or accept give26 do null; end give6;
or accept give27 do null; end give7;
or accept give28 do null; end give8;
or accept give29 do null; end give9;
or accept give30 do null; end give10;
or accept give31 do null; end give11;
end select;
end loop;
end link1;
begin
null;
end test;
--::::::::::
--ORDER32.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** ORDER32 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head;
task link1 is
entry give1;
entry give2;
entry give3;
entry give4;
entry give5;
entry give6;
entry give7;
entry give8;
entry give9;
entry give10;
entry give11;
entry give12;
entry give13;
entry give14;
entry give15;
entry give16;
entry give17;
entry give18;
entry give19;
entry give20;
entry give21;
entry give22;
entry give23;
entry give24;
entry give25;
entry give26;
entry give27;
entry give28;
entry give29;
entry give30;
entry give31;
entry give32;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 100;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give1;
link1.give2;
link1.give3;
link1.give4;
link1.give5;
link1.give6;
link1.give7;
link1.give8;
link1.give9;
link1.give10;
link1.give11;
link1.give12;
link1.give13;
link1.give14;
link1.give15;
link1.give16;
link1.give17;
link1.give18;
link1.give19;
link1.give20;
link1.give21;
link1.give22;
link1.give23;
link1.give24;
link1.give25;
link1.give26;
link1.give27;
link1.give28;
link1.give29;
link1.give30;
link1.give31;
link1.give32;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept give1 do null; end give1;
or accept give2 do null; end give2;
or accept give3 do null; end give3;
or accept give4 do null; end give4;
or accept give5 do null; end give5;
or accept give6 do null; end give6;
or accept give7 do null; end give7;
or accept give8 do null; end give8;
or accept give9 do null; end give9;
or accept give10 do null; end give10;
or accept give11 do null; end give11;
or accept give12 do null; end give12;
or accept give13 do null; end give13;
or accept give14 do null; end give14;
or accept give15 do null; end give15;
or accept give16 do null; end give16;
or accept give17 do null; end give17;
or accept give18 do null; end give18;
or accept give19 do null; end give19;
or accept give20 do null; end give20;
or accept give21 do null; end give1;
or accept give22 do null; end give2;
or accept give23 do null; end give3;
or accept give24 do null; end give4;
or accept give25 do null; end give5;
or accept give26 do null; end give6;
or accept give27 do null; end give7;
or accept give28 do null; end give8;
or accept give29 do null; end give9;
or accept give30 do null; end give10;
or accept give31 do null; end give11;
or accept give32 do null; end give12;
end select;
end loop;
end link1;
begin
null;
end test;
--::::::::::
--ORDER100.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** ORDER100 *****
-- ada tasking tester
-- task head is the controller
-- tasks link are the chain of tasks
-- tasks idle are the standby tasks
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
task head;
task link1 is
entry give1;
entry give2;
entry give3;
entry give4;
entry give5;
entry give6;
entry give7;
entry give8;
entry give9;
entry give10;
entry give11;
entry give12;
entry give13;
entry give14;
entry give15;
entry give16;
entry give17;
entry give18;
entry give19;
entry give20;
entry give21;
entry give22;
entry give23;
entry give24;
entry give25;
entry give26;
entry give27;
entry give28;
entry give29;
entry give30;
entry give31;
entry give32;
entry give33;
entry give34;
entry give35;
entry give36;
entry give37;
entry give38;
entry give39;
entry give40;
entry give41;
entry give42;
entry give43;
entry give44;
entry give45;
entry give46;
entry give47;
entry give48;
entry give49;
entry give50;
entry give51;
entry give52;
entry give53;
entry give54;
entry give55;
entry give56;
entry give57;
entry give58;
entry give59;
entry give60;
entry give61;
entry give62;
entry give63;
entry give64;
entry give65;
entry give66;
entry give67;
entry give68;
entry give69;
entry give70;
entry give71;
entry give72;
entry give73;
entry give74;
entry give75;
entry give76;
entry give77;
entry give78;
entry give79;
entry give80;
entry give81;
entry give82;
entry give83;
entry give84;
entry give85;
entry give86;
entry give87;
entry give88;
entry give89;
entry give90;
entry give91;
entry give92;
entry give93;
entry give94;
entry give95;
entry give96;
entry give97;
entry give98;
entry give99;
entry give100;
end link1;
task body head is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 100;
put_line("started");
for i in 1..cycles loop
if printon then put_line("head"); end if;
link1.give1;
link1.give2;
link1.give3;
link1.give4;
link1.give5;
link1.give6;
link1.give7;
link1.give8;
link1.give9;
link1.give10;
link1.give11;
link1.give12;
link1.give13;
link1.give14;
link1.give15;
link1.give16;
link1.give17;
link1.give18;
link1.give19;
link1.give20;
link1.give21;
link1.give22;
link1.give23;
link1.give24;
link1.give25;
link1.give26;
link1.give27;
link1.give28;
link1.give29;
link1.give30;
link1.give31;
link1.give32;
link1.give33;
link1.give34;
link1.give35;
link1.give36;
link1.give37;
link1.give38;
link1.give39;
link1.give40;
link1.give41;
link1.give42;
link1.give43;
link1.give44;
link1.give45;
link1.give46;
link1.give47;
link1.give48;
link1.give49;
link1.give50;
link1.give51;
link1.give52;
link1.give53;
link1.give54;
link1.give55;
link1.give56;
link1.give57;
link1.give58;
link1.give59;
link1.give60;
link1.give61;
link1.give62;
link1.give63;
link1.give64;
link1.give65;
link1.give66;
link1.give67;
link1.give68;
link1.give69;
link1.give70;
link1.give71;
link1.give72;
link1.give73;
link1.give74;
link1.give75;
link1.give76;
link1.give77;
link1.give78;
link1.give79;
link1.give80;
link1.give81;
link1.give82;
link1.give83;
link1.give84;
link1.give85;
link1.give86;
link1.give87;
link1.give88;
link1.give89;
link1.give90;
link1.give91;
link1.give92;
link1.give93;
link1.give94;
link1.give95;
link1.give96;
link1.give97;
link1.give98;
link1.give99;
link1.give100;
end loop;
put_line("ended");
end head;
task body link1 is
begin
loop
select
accept give1 do null; end give1;
or accept give2 do null; end give2;
or accept give3 do null; end give3;
or accept give4 do null; end give4;
or accept give5 do null; end give5;
or accept give6 do null; end give6;
or accept give7 do null; end give7;
or accept give8 do null; end give8;
or accept give9 do null; end give9;
or accept give10 do null; end give10;
or accept give11 do null; end give11;
or accept give12 do null; end give12;
or accept give13 do null; end give13;
or accept give14 do null; end give14;
or accept give15 do null; end give15;
or accept give16 do null; end give16;
or accept give17 do null; end give17;
or accept give18 do null; end give18;
or accept give19 do null; end give19;
or accept give20 do null; end give20;
or accept give21 do null; end give1;
or accept give22 do null; end give2;
or accept give23 do null; end give3;
or accept give24 do null; end give4;
or accept give25 do null; end give5;
or accept give26 do null; end give6;
or accept give27 do null; end give7;
or accept give28 do null; end give8;
or accept give29 do null; end give9;
or accept give30 do null; end give10;
or accept give31 do null; end give11;
or accept give32 do null; end give12;
or accept give33 do null; end give13;
or accept give34 do null; end give14;
or accept give35 do null; end give15;
or accept give36 do null; end give16;
or accept give37 do null; end give17;
or accept give38 do null; end give18;
or accept give39 do null; end give19;
or accept give40 do null; end give20;
or accept give41 do null; end give1;
or accept give42 do null; end give2;
or accept give43 do null; end give3;
or accept give44 do null; end give4;
or accept give45 do null; end give5;
or accept give46 do null; end give6;
or accept give47 do null; end give7;
or accept give48 do null; end give8;
or accept give49 do null; end give9;
or accept give50 do null; end give10;
or accept give51 do null; end give11;
or accept give52 do null; end give12;
or accept give53 do null; end give13;
or accept give54 do null; end give14;
or accept give55 do null; end give15;
or accept give56 do null; end give16;
or accept give57 do null; end give17;
or accept give58 do null; end give18;
or accept give59 do null; end give19;
or accept give60 do null; end give20;
or accept give61 do null; end give1;
or accept give62 do null; end give2;
or accept give63 do null; end give3;
or accept give64 do null; end give4;
or accept give65 do null; end give5;
or accept give66 do null; end give6;
or accept give67 do null; end give7;
or accept give68 do null; end give8;
or accept give69 do null; end give9;
or accept give70 do null; end give10;
or accept give71 do null; end give11;
or accept give72 do null; end give12;
or accept give73 do null; end give13;
or accept give74 do null; end give14;
or accept give75 do null; end give15;
or accept give76 do null; end give16;
or accept give77 do null; end give17;
or accept give78 do null; end give18;
or accept give79 do null; end give19;
or accept give80 do null; end give20;
or accept give81 do null; end give1;
or accept give82 do null; end give2;
or accept give83 do null; end give3;
or accept give84 do null; end give4;
or accept give85 do null; end give5;
or accept give86 do null; end give6;
or accept give87 do null; end give7;
or accept give88 do null; end give8;
or accept give89 do null; end give9;
or accept give90 do null; end give10;
or accept give91 do null; end give11;
or accept give92 do null; end give12;
or accept give93 do null; end give13;
or accept give94 do null; end give14;
or accept give95 do null; end give15;
or accept give96 do null; end give16;
or accept give97 do null; end give17;
or accept give98 do null; end give18;
or accept give99 do null; end give19;
or accept give100 do null; end give20;
end select;
end loop;
end link1;
begin
null;
end test;
--::::::::::
--SCHEDTEST.ADA
--::::::::::
--**********************************************************************
--* NEXT PROGRAM *
--**********************************************************************
--***** SCHEDTEST *****
-- schedtest : see if any tasks get starved
--
-- t1----------->slave<------------t3
-- t2----------->
--
-- t1 & t2 call entry1 in slave, t3 calls entry2
-- slave aborts after entered 1000 times
with text_io; use text_io;
procedure test is
cycles: integer;
printon: boolean;
answer: character;
call1: integer;
call2: integer;
task slave is
entry entry1;
entry entry2;
end slave;
task t1 is end t1;
task t2 is end t2;
task t3 is end t3;
task body t3 is
begin
loop
if printon then put_line("t3"); end if;
slave.entry2;
end loop;
end t3;
task body slave is
begin
put("do you want printing (y/n)? ");
get(answer);
put("answer is "); put(answer); put_line(" ");
if answer='y' then
printon := true;
else
printon := false;
end if;
if printon then put_line("printing on"); else put_line("print off");
end if;
call1 := 0;
call2 := 0;
put("how many cycles? ");
-- doesn't work get_line(cycles);
cycles := 1000;
put_line("started");
for i in 1..cycles loop
select
accept entry1 do
call1 := call1 + 1;
if printon then put_line("slave entry1"); end if;
end entry1;
or
accept entry2 do
call2 := call2 + 1;
if printon then put_line("slave entry2"); end if;
end entry2;
end select;
end loop;
put_line("ended");
-- put("entry1=");
-- put(call1);
-- put(" entry2=");
-- put(call2);
end slave;
task body t1 is
begin
loop
if printon then put_line("t1"); end if;
slave.entry1;
end loop;
end t1;
task body t2 is
begin
loop
if printon then put_line("t2"); end if;
slave.entry1;
end loop;
end t2;
begin
null;
end test;