home *** CD-ROM | disk | FTP | other *** search
Text File | 1988-05-03 | 103.5 KB | 4,935 lines |
-
-
-
- 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;
-