home *** CD-ROM | disk | FTP | other *** search
/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / test / tasking.doc < prev    next >
Encoding:
Text File  |  1988-05-03  |  107.5 KB  |  3,234 lines

  1.  
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.  
  9.  
  10.  
  11.  
  12.  
  13.  
  14.                              Ada* Benchmark Suite
  15.  
  16.                                Tasking Section
  17.  
  18.                                  Version 1.0
  19.  
  20.  
  21.  
  22.  
  23.  
  24.                                 29 August 1986
  25.  
  26.  
  27.  
  28.  
  29.  
  30.  
  31.  
  32.  
  33.  
  34.  
  35.                            Hughes Aircraft Company
  36.                              Ground Systems Group
  37.                         Software Engineering Division
  38.                   San Diego Software Engineering Laboratory
  39.                    Command and Control Software Department
  40.  
  41.  
  42.  
  43.  
  44.  
  45.  
  46.  
  47.  
  48.  
  49.  
  50.     * Ada is a registered trademark of the  U.S.   Government  (Ada  Joint
  51.     Program Office).
  52.     Ada Tasking Benchmark Version 1.0
  53.  
  54.  
  55.                                        CONTENTS
  56.  
  57.             1       PURPOSE  . . . . . . . . . . . . . . . . . . . . . . 1
  58.             2       TASKING BENCHMARK  . . . . . . . . . . . . . . . . . 1
  59.             2.1       Task Activation/Termination Test Category  . . . . 1
  60.             2.1.1       Local Array Of Null Task Bodies  . . . . . . . . 1
  61.             2.1.2       Local Array Of Tasks With Terminate Option . . . 2
  62.             2.1.3       Access Type  . . . . . . . . . . . . . . . . . . 2
  63.             2.2       Task Communication Test Category . . . . . . . . . 2
  64.             2.2.1       Simple Producer-Consumer . . . . . . . . . . . . 3
  65.             2.2.2       Selective Wait . . . . . . . . . . . . . . . . . 3
  66.             2.2.3       Producer-Consumer  . . . . . . . . . . . . . . . 3
  67.             2.2.4       Producer-Buffer-Consumer . . . . . . . . . . . . 3
  68.             2.2.5       Producer-Buffer-Transporter-Consumer . . . . . . 4
  69.             2.2.6       Producer-Transporter-Buffer-Transporter-Consumer 4
  70.             2.2.7       Relay  . . . . . . . . . . . . . . . . . . . . . 4
  71.             2.3       Task Optimizations Test Category . . . . . . . . . 5
  72.             2.3.1       Monitor  . . . . . . . . . . . . . . . . . . . . 5
  73.             2.3.2       Single Accept Bodies . . . . . . . . . . . . . . 5
  74.             2.4       Exception Propagation Test Category  . . . . . . . 5
  75.             2.4.1       Exception In A Block . . . . . . . . . . . . . . 6
  76.             2.4.2       Exception In A Procedure . . . . . . . . . . . . 6
  77.             2.4.3       Exception In An Entry  . . . . . . . . . . . . . 6
  78.             2.5       Task Interaction Test Category . . . . . . . . . . 6
  79.             2.5.1       Procedure Calling  . . . . . . . . . . . . . . . 6
  80.             2.5.2       Conditional Entry Call . . . . . . . . . . . . . 7
  81.             2.5.3       Timed Entry Call . . . . . . . . . . . . . . . . 7
  82.             2.5.4       Family Of Entries  . . . . . . . . . . . . . . . 7
  83.             2.5.5       Simple Synchronization . . . . . . . . . . . . . 8
  84.             2.5.6       Synchronization With Termination . . . . . . . . 8
  85.             2.5.7       Terminate Option   . . . . . . . . . . . . . . . 8
  86.             3       TIMING METHODOLOGY . . . . . . . . . . . . . . . . . 8
  87.             3.1       Timing Generic . . . . . . . . . . . . . . . . . . 9
  88.             3.2       Testing Environment  . . . . . . . . . . . . . . . 9
  89.             4       REFERENCES . . . . . . . . . . . . . . . . . . . .  10
  90.  
  91.  
  92.     APPENDIX A      BENCHMARK LISTINGS
  93.  
  94.             A.1     FILE ORGANIZATION  . . . . . . . . . . . . . . . . A-1
  95.             A.2     CPU_SPEC.ADA . . . . . . . . . . . . . . . . . . . A-2
  96.             A.3     CPU_BODY.ADA . . . . . . . . . . . . . . . . . . . A-3
  97.             A.4     MISC_BENCHMARK_SPEC.ADA  . . . . . . . . . . . . . A-5
  98.             A.5     MISC_BENCHMARK_SPEC.ADA  . . . . . . . . . . . . . A-6
  99.             A.6     TIMER_SPEC.ADA . . . . . . . . . . . . . . . . . . A-9
  100.             A.7     TIMER_BODY.ADA . . . . . . . . . . . . . . . . .  A-10
  101.             A.8     WALL_CLOCK_CPU_BODY.ADA  . . . . . . . . . . . .  A-12
  102.             A.9     PART1SPEC.ADA  . . . . . . . . . . . . . . . . .  A-13
  103.             A.10    PART1.ADA  . . . . . . . . . . . . . . . . . . .  A-14
  104.             A.11    PART2SPEC.ADA  . . . . . . . . . . . . . . . . .  A-17
  105.             A.12    PART2.ADA  . . . . . . . . . . . . . . . . . . .  A-18
  106.             A.13    PART3SPEC.ADA  . . . . . . . . . . . . . . . . .  A-31
  107.             A.14    PART3.ADA  . . . . . . . . . . . . . . . . . . .  A-32
  108.     Ada Tasking Benchmark Version 1.0
  109.  
  110.  
  111.             A.15    PART4SPEC.ADA  . . . . . . . . . . . . . . . . .  A-37
  112.             A.16    PART4.ADA  . . . . . . . . . . . . . . . . . . .  A-38
  113.             A.17    PART5SPEC.ADA  . . . . . . . . . . . . . . . . .  A-43
  114.             A.18    PART5.ADA  . . . . . . . . . . . . . . . . . . .  A-44
  115.             A.19    DRIVER.ADA   . . . . . . . . . . . . . . . . . .  A-54
  116.     Ada Tasking Benchmark Version 1.0                               Page 1
  117.  
  118.  
  119.     1  PURPOSE
  120.  
  121.     The Ada Benchmark Suite has been developed to provide a foundation for
  122.     the  performance  evaluation  of  various  Ada  compiler systems.  The
  123.     benchmarks are used to measure compilation speed and  execution  speed
  124.     of the Ada systems.
  125.  
  126.     This report describes the tasking benchmarks contained  in  the  suite
  127.     and  provides  a listing of the benchmarks in Appendix A.  This report
  128.     also describes the timing methodology used to gather measurements.
  129.  
  130.  
  131.  
  132.     2  TASKING BENCHMARK
  133.  
  134.     The use of  the  Ada  tasking  model  incurs  certain  overhead  costs
  135.     associated with, for example, task activation and termination, context
  136.     switching, and synchronization.  There are five general categories  of
  137.     tests,  with each category divided into individually timed tests.  The
  138.     Tasking benchmark  is  1904  source  lines  of  code.   The  following
  139.     paragraphs describe the tasking tests performed.
  140.  
  141.  
  142.  
  143.     2.1  Task Activation/Termination Test Category
  144.  
  145.     Since Ada does not include a real-time executive, task activation  and
  146.     termination  are  not  accomplished  via  programmer-written executive
  147.     service requests.  Task activation and termination in Ada is a part of
  148.     the tasking model semantics, and is perfomed automatically based on an
  149.     elaborate set of  rules  [BAR84,  p.209,  and  GEH84,  p.   45].   The
  150.     follwing  paragraphs  describe  the  task  activation  and termination
  151.     tests.
  152.  
  153.  
  154.  
  155.     2.1.1  Local Array Of Null Task Bodies
  156.  
  157.     Declaring a task within a procedure causes the task  to  be  activated
  158.     each  time  the procedure is called.  The procedure will not return to
  159.     its caller until the task terminates.
  160.  
  161.     In this test an array of tasks is declared  locally  to  a  procedure.
  162.     Both  the  procedure and the task have null bodies.  The length of the
  163.     array is determined by the iteration count (i.e., an iteration of  one
  164.     means  the  array length is one).  Therefore, the timing per iteration
  165.     is the time to activate and terminate one task in the array.
  166.     Ada Tasking Benchmark Version 1.0                               Page 2
  167.  
  168.  
  169.     2.1.2  Local Array Of Tasks With Terminate Option
  170.  
  171.     In this test an array of tasks is declared  locally  to  a  procedure.
  172.     The task uses the terminate option in a select statement to terminate.
  173.     The task is never called.  The length of the array  is  determined  by
  174.     the iteration count.
  175.  
  176.  
  177.  
  178.     2.1.3  Access Type
  179.  
  180.     It is possible to create tasks  dynamically  by  using  an  allocator.
  181.     Tasks created in this fashion are immediately activated.
  182.  
  183.     In this test an access type to a task is used to create  a  series  of
  184.     tasks.    The  timing  per  iteration  includes  both  allocation  and
  185.     deallocation of the task as well as activation and termination.
  186.  
  187.  
  188.  
  189.     2.2  Task Communication Test Category
  190.  
  191.     The  method  used  in  Ada  for  task  communcation  is   called   the
  192.     "rendezvous."  The rendezvous is a synchronous operation and therefore
  193.     limits the amount of asynchronous action between tasks.  It  is  often
  194.     desirable  to  uncouple [NIE86] the task interaction to some extent in
  195.     order  to  allow  more  independence  and  increase  the   amount   of
  196.     concurrency.   Intermediary  tasks  are  often used to accomplish this
  197.     uncoupling.   Intermediary  tasks   are   classified   as   "buffers,"
  198.     "transporters,"   or   "relays"   depending   upon  the  caller/called
  199.     relationships between the tasks.  A "buffer" is a  pure  server  task.
  200.     It  provides  one  entry for storing of items in a buffer, and another
  201.     entry for providing items from the buffer.  A "transporter" is a  pure
  202.     caller.   It  obtains  an item by calling a producer (or intermediary)
  203.     task,  and  "transports"  that  item  by  calling   a   consumer   (or
  204.     intermediary)  task.   A  "relay" is a mixture of a caller and server.
  205.     It obtains an item by calling a producer (or intermediary)  task,  and
  206.     "relays"  that  item when it is called by a consumer (or intermediary)
  207.     task.  (Alternately, a relay may be called by a producer, and  call  a
  208.     consumer).
  209.  
  210.     In addition to  providing  more  independence  between  tasks  (higher
  211.     degree  of  asynchronicity), intermediary tasks are also used to alter
  212.     the caller/called relationships.  Sometimes it is more advantageous to
  213.     be  a  called  task  and  other  times it is more advantageous to be a
  214.     calling task.  The use  of  a  buffer  allows  two  calling  tasks  to
  215.     communicate  while the use of a transporter allows two called tasks to
  216.     communicate.  A relay preserves the caller/called relationships  while
  217.     providing a degree of uncoupling.
  218.  
  219.     The case where one task passes information to another task is called a
  220.     producer-consumer  (PC)  relationship.  The task that is the source of
  221.     the information is called the  producer  and  the  task  that  is  the
  222.     Ada Tasking Benchmark Version 1.0                               Page 3
  223.  
  224.  
  225.     recipient  of  the  information  is  called the consumer.  One or more
  226.     rendezvous are used to pass the information from the producer  to  the
  227.     consumer.  A rendezvous is a rough measure of two Ada context switches
  228.     since the caller is suspended until the rendezvous is  complete.   The
  229.     first  context  switch  is  from the caller to the called task and the
  230.     second context switch is the return to the caller task.
  231.  
  232.     The following paragraphs describe the task communication tests.
  233.  
  234.  
  235.  
  236.     2.2.1  Simple Producer-Consumer
  237.  
  238.     In this test the main procedure  calls  a  consumer  task.   A  simple
  239.     integer  value  is  the  only data transferred and the consumer simply
  240.     loops on the accept.  Task activation/termination time is not included
  241.     in the timing.  An iteration consists of one rendezvous.
  242.  
  243.  
  244.  
  245.     2.2.2  Selective Wait
  246.  
  247.     In this test the main procedure calls a consumer  task  that  has  two
  248.     entries.   A simple integer value is the only data transferred and the
  249.     consumer simply loops on the selective accept.  This test differs from
  250.     the previous test in that the consumer uses a select statement to take
  251.     the entry call where the select has two  open  alternatives.   In  the
  252.     previous case there was no select statement.  An iteration consists of
  253.     one rendezvous.
  254.  
  255.  
  256.  
  257.     2.2.3  Producer-Consumer
  258.  
  259.     In this test  a  producer  task  communicates  with  a  consumer  task
  260.     directly.    This   timing   should   be   similar   to   the   simple
  261.     producer-consumer test.  An iteration consists of one rendezvous.
  262.  
  263.  
  264.  
  265.     2.2.4  Producer-Buffer-Consumer
  266.  
  267.     It is often the case that a producer and a consumer  will  communicate
  268.     via  a  buffer, i.e., producer-buffer-consumer (PBC).  A buffer serves
  269.     to uncouple the producer from the consumer  thus  providing  a  higher
  270.     degree  of  independence.   A  buffer is a task, and therefore its use
  271.     adds some overhead.  Each time a piece of information is  passed  from
  272.     the  producer to the consumer two rendezvous occur - the producer with
  273.     the buffer  and  the  consumer  with  the  buffer.   This  arrangement
  274.     requires  that  both  the  producer  and the consumer be calling tasks
  275.     since a buffer is strictly a called task.
  276.  
  277.     In this test  a  producer  task  communicates  with  a  consumer  task
  278.     Ada Tasking Benchmark Version 1.0                               Page 4
  279.  
  280.  
  281.     indirectly  through  a bounded buffer (buffer size = 2).  An iteration
  282.     consists of two rendezvous.
  283.  
  284.  
  285.  
  286.     2.2.5  Producer-Buffer-Transporter-Consumer
  287.  
  288.     Many times a producer will want to communicate with a consumer  via  a
  289.     buffer,  but  it is undesirable for the consumer to be a calling task.
  290.     For example, the consumer may want to accept requests from any  number
  291.     of  producers  and therefore would want to be a called task.  This can
  292.     be accomplished by having a transporter task take information from the
  293.     buffer     and     pass    it    on    to    the    consumer,    i.e.,
  294.     producer-buffer-transporter-consumer  (PBTC).   This  means  that  two
  295.     intermediary  tasks  are  used  between the producer and the consumer.
  296.     Each time a piece of information is passed from the  producer  to  the
  297.     consumer  three  rendezvous  occur - the producer with the buffer, the
  298.     transporter with the buffer, and the transporter with the consumer.
  299.  
  300.     In this test  a  producer  task  communicates  with  a  consumer  task
  301.     indirectly  through  a  bounded  buffer  (buffer  size  =  2)  with  a
  302.     transporter  between  the  buffer  and  the  consumer.   An  iteration
  303.     consists of three rendezvous.
  304.  
  305.  
  306.  
  307.     2.2.6  Producer-Transporter-Buffer-Transporter-Consumer
  308.  
  309.     In the event that a producer and a consumer wish to communicate via  a
  310.     buffer  and  both  need  to  be called tasks, it is necessary to use a
  311.     transporter  on  each  side  of  the  buffer.   This  results  in  the
  312.     producer-transporter-buffer-transporter-consumer   (PTBTC)   paradigm.
  313.     Each time a piece of information is passed from the  producer  to  the
  314.     consumer  four rendezvous occur - a transporter with the producer, the
  315.     transporter with the buffer, a second transporter with the buffer, and
  316.     the second transporter with the consumer.
  317.  
  318.     In this test  a  producer  task  communicates  with  a  consumer  task
  319.     indirectly  through  a  bounded  buffer  (buffer  size  =  2)  with  a
  320.     transporter for both the producer  and  the  consumer.   An  iteration
  321.     consists of four rendezvous.
  322.  
  323.  
  324.  
  325.     2.2.7  Relay
  326.  
  327.     A relay is an intermediary task that takes information from a producer
  328.     and  passes it on to the consumer.  For each piece of information that
  329.     is passed from the producer to the consumer two rendezvous occur - the
  330.     producer with the relay and the relay with the consumer.
  331.  
  332.     In this test  a  producer  task  communicates  with  a  consumer  task
  333.     indirectly through a relay.  In terms of the task communication model,
  334.     Ada Tasking Benchmark Version 1.0                               Page 5
  335.  
  336.  
  337.     this resembles th PBTC paradigm but in terms of performance it  should
  338.     resemble the PBC test.  An iteration consists of two rendezvous.
  339.  
  340.  
  341.  
  342.     2.3  Task Optimizations Test Category
  343.  
  344.     This test category determines if the implementation optimizes  various
  345.     special cases of tasking.  The specific optimizations being tested for
  346.     are machine independent optimizations that have been discussed in  the
  347.     Ada  literature  [HIL82,  HAB80].   For each specific optimization the
  348.     general case and the special case are timed.  If the special  case  is
  349.     significantly faster than the general case then it is assumed that the
  350.     optimization technique is employed.   An  iteration  consists  of  the
  351.     general  case  time  minus the special case time.  For iteration times
  352.     near zero, it can be assumed that the optimization is not done.
  353.  
  354.  
  355.  
  356.     2.3.1  Monitor
  357.  
  358.     A task  that  contains  no  code  outside  of  the  accept  bodies  is
  359.     considered  to  be a monitor.  It is possible to eliminate such a task
  360.     by protecting the task entries with semaphores.
  361.  
  362.     In this test the main procedure interacts with a monitor  and  with  a
  363.     more  general  task  in  order  to  determine  if this optimization is
  364.     performed.
  365.  
  366.  
  367.  
  368.     2.3.2  Single Accept Bodies
  369.  
  370.     In the case where a task entry has a single accept body  there  is  no
  371.     need for the indirect referencing that may be used when a single entry
  372.     has multiple accept bodies.
  373.  
  374.     This test checks to see if calls to entries that have a single  accept
  375.     body are more efficient than when multiple accept bodies are used.
  376.  
  377.  
  378.  
  379.     2.4  Exception Propagation Test Category
  380.  
  381.     The  raising  of  an  exception  is  the  means  by  which  error  and
  382.     exceptional  conditions  are reported in Ada.  An exception handler is
  383.     used to respond to an exception that has been raised.  Three types  of
  384.     exception  handling are examined here to determine the cost of raising
  385.     and  propagating  an  exception.   Each  test  is  timed  without  the
  386.     exception  being  raised  and  with  the  exception  being raised.  An
  387.     iteration consists of the difference in these times (raised minus  not
  388.     raised).
  389.     Ada Tasking Benchmark Version 1.0                               Page 6
  390.  
  391.  
  392.     2.4.1  Exception In A Block
  393.  
  394.     A block is a statement that may contain declarations,  a  sequence  of
  395.     statements, and an exception handler.  An exception that is raised and
  396.     handled within the same  block  is  the  simplest  form  of  exception
  397.     handling.
  398.  
  399.     In this test an exception is raised and handled  in  the  same  block.
  400.     The  user defined exception is declared local to the block where it is
  401.     raised.
  402.  
  403.  
  404.  
  405.     2.4.2  Exception In A Procedure
  406.  
  407.     If an exception is raised within a procedure that  does  not  have  an
  408.     exception handler for that exception, then the exception is propagated
  409.     to the caller procedure.
  410.  
  411.     In this test an exception is raised in a procedure and handled by  the
  412.     caller.
  413.  
  414.  
  415.  
  416.     2.4.3  Exception In An Entry
  417.  
  418.     If an exception is raised within a rendezvous, then it  is  propagated
  419.     to  the  task  containing  the  accept as well as to the calling task.
  420.     This is  the  most  complex  form  of  exception  handling  since  the
  421.     exception is handled in both the task containing the accept and by the
  422.     calling task.
  423.  
  424.     In this  test  an  exception  is  raised  during  a  rendezvous.   The
  425.     exception is handled in both the calling environment and in the called
  426.     task.
  427.  
  428.  
  429.  
  430.     2.5  Task Interaction Test Category
  431.  
  432.     This test  category  times  various  task  interactions  in  order  to
  433.     determine  their  relative  cost.  These tests are related to the task
  434.     communication tests and in many cases the output should be compared to
  435.     those tests.
  436.  
  437.  
  438.  
  439.     2.5.1  Procedure Calling
  440.  
  441.     In this test the time to do a procedure call is measured so it can  be
  442.     used in comparing the tasking overhead to the time of a procedure call
  443.     (i.e., normalized to a procedure  call).   The  procedure  contains  a
  444.     minimum  amount  of code, just enough to keep a compiler from thinking
  445.     Ada Tasking Benchmark Version 1.0                               Page 7
  446.  
  447.  
  448.     it can be eliminated.  An iteration consists of one procedure call.
  449.  
  450.  
  451.  
  452.     2.5.2  Conditional Entry Call
  453.  
  454.     When one task wishes to call an entry  in  another  task  it  has  the
  455.     option of:
  456.  
  457.          a.  making the call if and only if the called task  is  ready  to
  458.              accept the call, or
  459.  
  460.          b.  blocking until the called task is ready.
  461.  
  462.     The first of these two choices is a conditional entry call.
  463.  
  464.     In this test  the  main  procedure  calls  a  consumer  task  using  a
  465.     conditional  entry  call.   The  test  first  tries calls that are not
  466.     accepted, then tries calls that are accepted.  Since the  consumer  is
  467.     the  same  type of consumer used in the other producer/consumer tests,
  468.     these results can be compared to the  simple  producer/consumer  test.
  469.     An  iteration  consists  of  the "accepted call timing" minus the "not
  470.     accepted call timing" (i.e., the rendezvous time plus the overhead  of
  471.     the conditional call).
  472.  
  473.  
  474.  
  475.     2.5.3  Timed Entry Call
  476.  
  477.     Like the conditional entry mechanism, the timed entry mechanism  gives
  478.     the  calling task a degree of control over the call to the task entry.
  479.     A timed entry call allows the calling task to specify how long  it  is
  480.     willing  to  wait  for  the  rendezvous  to start.  If this time limit
  481.     expires prior to  the  start  of  the  rendezvous  then  the  call  is
  482.     cancelled.
  483.  
  484.     In this test the main procedure calls a consumer  task  with  a  timed
  485.     entry  call containing a time limit of 0.0.  The test tries calls that
  486.     are not accepted then  tries  calls  that  are  accepted.   Since  the
  487.     consumer   is   the   same   type   of  consumer  used  in  the  other
  488.     producer/consumer tests, these results can be compared to  the  simple
  489.     producer/consumer  test.   An iteration consists of the "accepted call
  490.     timing" minus the "not accepted call  timing"  (i.e.,  the  rendezvous
  491.     time plus the overhead of the timed entry call).
  492.  
  493.  
  494.  
  495.     2.5.4  Family Of Entries
  496.  
  497.     This test is similar to the simple producer/consumer in that the  main
  498.     procedure  produces  integer  values  that  are consumed by a consumer
  499.     task.  The difference is that the  consumer  task  uses  a  family  of
  500.     entries  instead  of  a  single  entry.   An iteration consists of one
  501.     Ada Tasking Benchmark Version 1.0                               Page 8
  502.  
  503.  
  504.     rendezvous.
  505.  
  506.  
  507.  
  508.     2.5.5  Simple Synchronization
  509.  
  510.     This test times the use of a simple synchronization  task  entry.   In
  511.     this  type  of  task  interaction no parameters are passed to the task
  512.     entry and there is no body for the accept.  The called task  loops  on
  513.     an unconditional accept.  An iteration consists of one rendezvous.
  514.  
  515.  
  516.  
  517.     2.5.6  Synchronization With Termination
  518.  
  519.     This test times the use of a simple synchronization  task  entry.   In
  520.     this  type  of  task  interaction no parameters are passed to the task
  521.     entry and there is no body for the accept.  The called task loops on a
  522.     select statement containing an accept and a terminate alternative.  An
  523.     iteration consists of one rendezvous.
  524.  
  525.  
  526.  
  527.     2.5.7  Terminate Option
  528.  
  529.     A group of tasks can cooperatively terminate by  using  the  terminate
  530.     option of the select statement.
  531.  
  532.     This test times the use of a simple synchronization  task  entry  both
  533.     without and with a terminate option.  In this type of task interaction
  534.     no parameters are passed to the task entry and there is  no  body  for
  535.     the accept.  The called task loops on a select statement containing an
  536.     accept and a conditional terminate alternative.  An iteration consists
  537.     of the difference in time between having the terminate option open and
  538.     having the terminate option closed.
  539.  
  540.  
  541.  
  542.     3  TIMING METHODOLOGY
  543.  
  544.     This section  describes  the  timing  methodology  employed  with  the
  545.     benchmark  tests.  For compiler speed, the measurements are taken from
  546.     the timing information  generated  by  the  compiler.   For  execution
  547.     speed,  a  generic package is used by the benchmark programs to output
  548.     the CPU time and wall-clock time elapsed during the execution  of  the
  549.     benchmark  program.   The benchmark programs are compiled and executed
  550.     in a controlled environment to limit distortion of measurements.
  551.     Ada Tasking Benchmark Version 1.0                               Page 9
  552.  
  553.  
  554.     3.1  Timing Generic
  555.  
  556.     The generic package Benchmark is used by  the  benchmark  programs  to
  557.     output  timing  measurements.  The package specification for Benchmark
  558.     is shown below:
  559.  
  560.  
  561.     with Misc_Benchmark; use Misc_Benchmark;
  562.     generic
  563.         Test_Repetitions     : NATURAL := 5;  
  564.         -- run the entire test this many times
  565.         -- to check for variability in results
  566.  
  567.         Number_of_Iterations : NATURAL := 0;
  568.         -- 0 implies the number of iterations
  569.         -- is to be determined.
  570.  
  571.         with procedure Overhead (Iterations : in NATURAL) 
  572.              is Default_Overhead;
  573.         with procedure Item_Of_Interest (Iterations : in NATURAL);
  574.  
  575.     package Benchmark is
  576.       procedure Timer;
  577.     end Benchmark;
  578.  
  579.  
  580.     The generic parameter Item_of_Interest is  the  benchmark  program  or
  581.     feature  that  is  measured.   The  generic  parameter Overhead is the
  582.     overhead involved with measuring Item_Of_Interest.
  583.  
  584.     After being instantiated as (for example):
  585.  
  586.  
  587.        package New_Benchmark is new Benchmark (Item_Of_Interest =>
  588.                                                Thing_To_Be_Measured);
  589.  
  590.  
  591.     a call to New_Benchmark.Timer causes the measurements for this test to
  592.     be  timed  and  output.   The  measurements  are  based on a number of
  593.     iterations of the "Thing_To_Be_Measured" calculated  as:   the  number
  594.     that  is  required  to have the measurements one hundred times greater
  595.     than the resolution of the system time.
  596.  
  597.     When available, a system call to a timer function  is  supplied  in  a
  598.     library unit.
  599.  
  600.  
  601.  
  602.     3.2  Testing Environment
  603.  
  604.     The testing environment is  controlled  to  limit  the  distortion  of
  605.     timing  measurements  [CLA86].   Benchmark  programs  are compiled and
  606.     executed in a batch mode in the evening.  Although  this  scheme  does
  607.     Ada Tasking Benchmark Version 1.0                              Page 10
  608.  
  609.  
  610.     not  entirely  eliminate  operating  system  interference  (i.e., time
  611.     slicing, daemon processes, and paging) or other user interference, the
  612.     results are more realistic than those obtained in an interactive mode.
  613.  
  614.  
  615.  
  616.     4  REFERENCES
  617.  
  618.                               ___________ __ ___
  619.     BAR84   Barnes, J. G. P., Programming in Ada, Second Edition,
  620.             Addison-Wesly, 1984.
  621.  
  622.     CLA86   Clapp, R.M., Duchesneau, L., Volz, R.A., Mudge, T.N., and
  623.                           ______ _________ ___________ __________
  624.             Schultze, T., Toward Real-Time Performance Benchmarks 
  625.             ___ ___
  626.             for Ada, RSD-TR-6-86, Electrical Engineering and Computer
  627.             Science Department, University of Michigan, Ann Arbor, 
  628.             January, 1986.
  629.  
  630.                         ___ __________ ___________
  631.     GEH84   Gehani, N., Ada Concurrent Programming, Prentice-Hall,
  632.             1984.
  633.  
  634.     HAB80   Habermann, A. N. and I. R. Nassi, "Efficient Implementation of
  635.             Ada Tasks," Technical Report CMU-CS-80-103, Carnegie-Mellon 
  636.             University, January 1980.
  637.  
  638.     HIL82   Hilfinger, D. N., "Implementation Strategies for Ada Tasking 
  639.             Idioms," Proceedings of the AdaTEC Conference on Ada, 
  640.             October 6-8, 1982.
  641.  
  642.     NIE86   Nielsen, K. W., "Task Coupling and Cohesion in Ada," Ada 
  643.             Letters, Volume VI, Number 4, July/August 1986.
  644.  
  645.     WEI84   Weicker, R. P., "Dhrystone: A Synthetic Systems Programming 
  646.             Benchmark," Communications of the ACM, October 1984.
  647.  
  648.  
  649.  
  650.  
  651.  
  652.  
  653.  
  654.  
  655.  
  656.  
  657.  
  658.  
  659.                                   APPENDIX A
  660.  
  661.                               BENCHMARK LISTINGS
  662.  
  663.  
  664.  
  665.     A.1  FILE ORGANIZATION
  666.  
  667.     The organization of the files for these benchmarks is presented below.
  668.  
  669.     The timing benchmark files must be compiled first,  in  the  following
  670.     order:
  671.  
  672.          a.  CPU_SPEC.ADA
  673.          b.  CPU_BODY.ADA
  674.          c.  MISC_BENCHMARK_SPEC.ADA
  675.          d.  MISC_BENCHMARK_BODY.ADA
  676.          e.  TIMER_SPEC.ADA
  677.          f.  TIMER_BODY.ADA
  678.  
  679.  
  680.     The file WALL_CLOCK_CPU_BODY.ADA outputs the elapsed time as  the  cpu
  681.     time.  This is machine independent and can be used until a CPU_BODY is
  682.     developed for the specific target machine.
  683.  
  684.     The tasking benchmark files must be compiled in the following order:
  685.  
  686.          a.  package specification  file  before  respective  body  (e.g.,
  687.              PART1SPEC.ADA before PART1.ADA)
  688.  
  689.          b.  all the specifications must be compiled before DRIVER.ADA.
  690.  
  691.     Ada Benchmark Suite Version 1.0                               Page A-2
  692.  
  693.  
  694.     A.2  CPU_SPEC.ADA
  695.  
  696.     The following is a listing of the specification for package Cpu:
  697.  
  698.  
  699.  
  700.     --  this is a machine specific package for reporting the amount of
  701.     --  CPU time used. 
  702.     package Cpu is
  703.       type Time is private;
  704.  
  705.         --  The time returned by Clock can only be used to determine the
  706.         --  difference between two times.
  707.       function Clock return Time;
  708.  
  709.         -- subtracting two times will result in the duration (seconds).
  710.       function "-" (Stop_Time, Start_Time : Time) return DURATION;
  711.     private
  712.       type Time is new DURATION;
  713.     end Cpu;
  714.  
  715.  
  716.     Ada Benchmark Suite Version 1.0                               Page A-3
  717.  
  718.  
  719.     A.3  CPU_BODY.ADA
  720.  
  721.     The following is a listing of the body for package Cpu:
  722.  
  723.  
  724.  
  725.     --  this is a machine specific package for reporting the amount of
  726.     --  CPU time used. The CPU time is expressed in centiseconds.
  727.     with TEXT_IO;   use TEXT_IO;
  728.     with SYSTEM;
  729.     package body Cpu is
  730.  
  731.       type Item_List is
  732.                record
  733.                   Code            : SHORT_INTEGER;
  734.                   Buffer_Length   : SHORT_INTEGER;
  735.                   Buffer_Address  : SYSTEM.ADDRESS;
  736.                   Return_Len_Addr : SYSTEM.ADDRESS;
  737.                   End_List        : INTEGER := 0;  -- marks end of requests
  738.                end record;
  739.  
  740.       for Item_List use
  741.                record
  742.                   Code                at 0 range 16 .. 31;
  743.                   Buffer_Length       at 0 range 0  .. 15;
  744.                   Buffer_Address      at 4 range 0  .. 31;
  745.                   Return_Len_Addr     at 8 range 0  .. 31;
  746.                   End_List            at 12 range 0  .. 31;
  747.                end record;
  748.  
  749.  
  750.       procedure GetJPIW (Status : out INTEGER;
  751.                          Efn    : in  INTEGER := 0;  -- not used
  752.                          PidAdr : in  INTEGER := INTEGER'NULL_PARAMETER;
  753.                          PrcNam : in  INTEGER := INTEGER'NULL_PARAMETER;
  754.                          ItmLst : in out Item_List;
  755.                          Iosb   : in  INTEGER := INTEGER'NULL_PARAMETER;
  756.                          AstAdr : in  INTEGER := INTEGER'NULL_PARAMETER;
  757.                          AstPrm : in  INTEGER := INTEGER'NULL_PARAMETER;
  758.                          Nullarg: in  INTEGER := INTEGER'NULL_PARAMETER);
  759.       pragma INTERFACE (SYSTEM, GetJPIW);
  760.       pragma IMPORT_VALUED_PROCEDURE (GetJPIW, "SYS$GETJPIW",
  761.                 MECHANISM => (VALUE, REFERENCE, REFERENCE, DESCRIPTOR, REFERENCE,
  762.                               REFERENCE, REFERENCE, REFERENCE, REFERENCE));
  763.  
  764.       function Clock return Time is
  765.         JPI_CPUTIM : constant := 1031;  -- accumulated cpu time
  766.         Rslt_Len,
  767.         Ticks     : INTEGER := 0;
  768.         Rqst      : Item_List;
  769.         Status    : INTEGER;
  770.         pragma VOLATILE (Ticks);
  771.         pragma VOLATILE (Rslt_Len);
  772.     Ada Benchmark Suite Version 1.0                               Page A-4
  773.  
  774.  
  775.       begin
  776.         Rqst.Buffer_Length   := 4;  -- 4 bytes in a longword
  777.         Rqst.Buffer_Address  := Ticks'ADDRESS;
  778.         Rqst.Return_Len_Addr := Rslt_Len'ADDRESS;
  779.         Rqst.Code            := JPI_CPUTIM;
  780.         GetJPIW (Status => Status,  ItmLst => Rqst);
  781.         if Status /= 1 or Rslt_Len /= 4 then
  782.           PUT_LINE ("bad status from Get_JPIW = " & INTEGER'IMAGE (Status) &
  783.                      "  len = " & INTEGER'IMAGE (Rslt_Len));
  784.         end if;
  785.         return Time(Time(Ticks) * Time(0.01));
  786.       end Clock;
  787.  
  788.  
  789.     function "-" (Stop_Time, Start_Time : Time) return DURATION is
  790.     begin
  791.       return DURATION (DURATION (Stop_Time) - DURATION (Start_Time));
  792.     end "-";
  793.  
  794.     begin
  795.       null;
  796.     end Cpu;
  797.  
  798.  
  799.     Ada Benchmark Suite Version 1.0                               Page A-5
  800.  
  801.  
  802.     A.4  MISC_BENCHMARK_SPEC.ADA
  803.  
  804.     The following is a listing of the specification for package Misc_Benchmark:
  805.  
  806.  
  807.  
  808.     --  this is a package which provides a default
  809.     --  for the overhead timing subprogram in the Benchmark Generic
  810.     --  as well as miscellaneous timing routines.
  811.     with CALENDAR; use CALENDAR;
  812.     with Cpu; use Cpu;
  813.     package Misc_Benchmark is
  814.       type Time_Info is private;
  815.       type Raw_Time_Info is private;
  816.       type Results_Type is array (NATURAL range <>) of Time_Info;
  817.  
  818.       procedure Get_Both_Times (Now : out Raw_Time_Info);
  819.       function "-" (Stop, Start : in Raw_Time_Info) return Time_Info;
  820.       procedure Print_Results (Results : in Results_Type;
  821.                                Overhead_Results : in Results_Type;
  822.                                Test_Repetitions : NATURAL;
  823.                                Iterations : NATURAL);
  824.  
  825.       procedure Default_Overhead (Iterations : in NATURAL);
  826.  
  827.     private
  828.       type Time_Info is record
  829.              Elapsed_Time,
  830.              Cpu_Time : DURATION;
  831.            end record;
  832.  
  833.       type Raw_Time_Info is record
  834.              Elapsed_Time  : CALENDAR.TIME;
  835.              Cpu_Time      : Cpu.Time;
  836.            end record;
  837.  
  838.     end Misc_Benchmark;
  839.     Ada Benchmark Suite Version 1.0                               Page A-6
  840.  
  841.  
  842.     A.5  MISC_BENCHMARK_SPEC.ADA
  843.  
  844.     The following is a listing of the body for package Misc_Benchmark:
  845.  
  846.  
  847.  
  848.     --  this is a package which provides a default
  849.     --  for the overhead timing subprogram in the Benchmark Generic
  850.     --  as well as miscellaneous timing routines.
  851.     with TEXT_IO; use TEXT_IO;
  852.     with CALENDAR; use CALENDAR;
  853.     with Cpu; use Cpu;
  854.     package body Misc_Benchmark is
  855.  
  856.     procedure Get_Both_Times (Now : out Raw_Time_Info) is
  857.     -- retrieves the current elapsed time and cpu time
  858.     begin
  859.       Now.Elapsed_Time := CALENDAR.CLOCK;
  860.       Now.Cpu_Time := Cpu.Clock;
  861.     end Get_Both_Times;
  862.  
  863.     function "-" (Stop, Start : in Raw_Time_Info) return Time_Info is
  864.     begin
  865.       return (Elapsed_Time => Stop.Elapsed_Time - Start.Elapsed_Time,
  866.               Cpu_Time => Stop.Cpu_Time - Start.Cpu_Time);
  867.     end "-";
  868.  
  869.     procedure Print_Results (Results : in Results_Type;
  870.                              Overhead_Results : in Results_Type;
  871.                              Test_Repetitions : NATURAL;
  872.                              Iterations : NATURAL) is
  873.  
  874.       package Duration_IO is new FIXED_IO (DURATION);
  875.       use Duration_IO;
  876.  
  877.       type Net_Cpu_Type is array (1..Test_Repetitions) of DURATION;
  878.       Net_Cpus : Net_Cpu_Type;  -- contains the Net Cpu per repetition
  879.       Total_Cpu : DURATION := 0.0;
  880.  
  881.     begin
  882.       NEW_LINE;
  883.       PUT("Number of iterations executed per repetition: ");
  884.       PUT(NATURAL'IMAGE(Iterations));
  885.       NEW_LINE;
  886.       NEW_LINE;
  887.       PUT_LINE("Note that all times are in seconds.");
  888.       NEW_LINE;
  889.  
  890.       -- build table header
  891.       PUT("|-----------------------------------------------------------------");
  892.       PUT_LINE("-------------|");
  893.       PUT("| REPETITION |  OVERHEAD  |    TEST    |     NET    |   TEST     |");
  894.       PUT_LINE(" NET CPU PER |");
  895.     Ada Benchmark Suite Version 1.0                               Page A-7
  896.  
  897.  
  898.       PUT("| NUMBER     |  CPU       |    CPU     |     CPU    |   ELAPSED  |");
  899.       PUT_LINE(" ITERATION   |");
  900.  
  901.       for Repetitions in 1..Test_Repetitions loop
  902.         PUT("|------------|------------|------------|------------|------------|");
  903.         PUT_LINE("-------------|");
  904.         PUT("|     ");
  905.         PUT(NATURAL'IMAGE(Repetitions));
  906.         SET_COL(14); 
  907.         PUT("| "); 
  908.         PUT(Overhead_Results (Repetitions).Cpu_Time,FORE => 5);
  909.         SET_COL(27);
  910.         PUT("| "); 
  911.         PUT(Results (Repetitions).Cpu_Time,FORE => 5);
  912.         SET_COL(40);
  913.         PUT("| ");
  914.         Net_Cpus(Repetitions) := DURATION(Results(Repetitions).Cpu_Time - 
  915.                                           Overhead_Results(Repetitions).Cpu_Time);
  916.         Total_Cpu := Total_Cpu + Net_Cpus(Repetitions);
  917.         PUT(Net_Cpus(Repetitions),FORE => 5);
  918.         SET_COL(53);
  919.         PUT("| ");
  920.         PUT(Results (Repetitions).Elapsed_Time,FORE => 5);
  921.         SET_COL(66);
  922.         PUT("|  ");
  923.         PUT(DURATION(Net_Cpus(Repetitions) / DURATION(Iterations)),FORE => 5);
  924.         SET_COL(80);
  925.         PUT_LINE("|");
  926.       end loop;
  927.  
  928.       PUT("|-----------------------------------------------------------------");
  929.       PUT_LINE("-------------|");
  930.  
  931.       -- Output Net Cpu time averaged across repetitions
  932.       NEW_LINE;
  933.       NEW_LINE;
  934.       PUT("The average net cpu time (across repetitions) was: ");
  935.       PUT(DURATION(Total_Cpu / DURATION(Test_Repetitions)),FORE=>5);
  936.       NEW_LINE;
  937.       PUT("The average net cpu time per iteration was: ");
  938.       PUT(DURATION(Total_Cpu / DURATION(Test_Repetitions * Iterations)),FORE=>5);
  939.       NEW_LINE;
  940.       NEW_LINE;
  941.       PUT_LINE((1..80=> '-'));
  942.       PUT_LINE((1..80=> '-'));
  943.     end Print_Results;
  944.  
  945.  
  946.     procedure Default_Overhead (Iterations : in NATURAL) is
  947.     begin
  948.       for Loop_Count in 1..Iterations loop
  949.         null;
  950.       end loop;
  951.     Ada Benchmark Suite Version 1.0                               Page A-8
  952.  
  953.  
  954.     end Default_Overhead;
  955.  
  956.     begin
  957.       null;
  958.     end Misc_Benchmark;
  959.     Ada Benchmark Suite Version 1.0                               Page A-9
  960.  
  961.  
  962.     A.6  TIMER_SPEC.ADA
  963.  
  964.     The following is a listing of the specification for package Benchmark:
  965.  
  966.  
  967.  
  968.     --++
  969.     -- FACILITY:
  970.     --      Benchmark Driver
  971.     --
  972.     -- ABSTRACT:
  973.     --      This generic procedure provides the services necessary to time
  974.     --      a given operaion and report on the performance.
  975.     --
  976.     -- AUTHOR:
  977.     --      Tom Burger
  978.     --
  979.     -- MODIFICATION HISTORY:
  980.     ---- 
  981.     with Misc_Benchmark; use Misc_Benchmark;
  982.     generic
  983.         Test_Repetitions     : NATURAL := 5;  -- run the entire test this many times
  984.                                               -- to check for variability in results
  985.         Number_of_Iterations : NATURAL := 0;  -- 0 implies the number of iterations
  986.                                               -- is to be determined.
  987.  
  988.         with procedure Overhead (Iterations : in NATURAL) is Default_Overhead;
  989.         with procedure Item_Of_Interest (Iterations : in NATURAL);
  990.  
  991.     package Benchmark is
  992.       procedure Timer;
  993.     end Benchmark;
  994.  
  995.  
  996.     Ada Benchmark Suite Version 1.0                              Page A-10
  997.  
  998.  
  999.     A.7  TIMER_BODY.ADA
  1000.  
  1001.     The following is a listing of the body for package Benchmark:
  1002.  
  1003.  
  1004.  
  1005.     --++
  1006.     -- FACILITY:
  1007.     --      Benchmark Driver
  1008.     --
  1009.     -- ABSTRACT:
  1010.     --      This generic procedure provides the services necessary to time
  1011.     --      a given operaion and report on the performance.
  1012.     --
  1013.     -- AUTHOR:
  1014.     --      Tom Burger
  1015.     --
  1016.     -- MODIFICATION HISTORY:
  1017.     ----
  1018.  
  1019.     with TEXT_IO;  use TEXT_IO;
  1020.     with Cpu;      use Cpu;
  1021.     with Misc_Benchmark; use Misc_Benchmark;
  1022.     with SYSTEM;                        -- for SYSTEM.TICK
  1023.     package body Benchmark is
  1024.  
  1025.     Iterations : NATURAL;     -- how many iterations to run the test
  1026.  
  1027.     procedure Determine_Necessary_Iterations is
  1028.       -- If a specified number of iterations is given then use this number;
  1029.       -- otherwise, determine the best number of iterations by starting at 1 and
  1030.       -- keep doubling the number of iterations until the time required for
  1031.       -- the item of interest is at least 100 times the clock resolution.
  1032.       -- The result of this procedure is left in the variable Iterations.
  1033.  
  1034.       Minimum_Time : DURATION;
  1035.       Start_Cpu,
  1036.       Stop_Cpu   : Cpu.Time;
  1037.     begin
  1038.       if Number_Of_Iterations /= 0 then
  1039.         Iterations := Number_Of_Iterations;
  1040.         return;
  1041.       end if;
  1042.  
  1043.       if SYSTEM.TICK > DURATION'SMALL then  
  1044.         Minimum_Time := 100 * SYSTEM.TICK;
  1045.       else
  1046.         Minimum_Time := 100 * DURATION'SMALL;
  1047.       end if;
  1048.  
  1049.       Iterations := 1;
  1050.       loop
  1051.         Start_Cpu := Cpu.Clock;
  1052.     Ada Benchmark Suite Version 1.0                              Page A-11
  1053.  
  1054.  
  1055.         Item_Of_Interest (Iterations);
  1056.         Stop_Cpu := Cpu.Clock;
  1057.  
  1058.         exit when Stop_Cpu - Start_Cpu >= Minimum_Time;
  1059.  
  1060.           -- check for overflow condition
  1061.         if Iterations = NATURAL'LAST / 2 + 1 then
  1062.           Iterations := NATURAL'LAST;
  1063.           exit;
  1064.         end if;
  1065.         Iterations := Iterations * 2;
  1066.       end loop;
  1067.     end Determine_Necessary_Iterations;
  1068.  
  1069.       
  1070.     procedure Do_Timing_Run (Results : out Results_Type;
  1071.                              Overhead_Results : out Results_Type) is
  1072.  
  1073.       Start,
  1074.       Stop   : Raw_Time_Info;          -- Contains Elapsed and Cpu Times
  1075.  
  1076.     begin               
  1077.       for Repetitions in 1..Test_Repetitions loop
  1078.         Get_Both_Times (Start);
  1079.         Overhead (Iterations);  -- run the overhead routine
  1080.         Get_Both_Times (Stop);
  1081.         Overhead_Results (Repetitions) := Stop - Start;
  1082.  
  1083.         Get_Both_Times (Start);
  1084.         Item_Of_Interest (Iterations);  -- run the item of interest routine
  1085.         Get_Both_Times (Stop);
  1086.         Results (Repetitions) := Stop - Start;
  1087.       end loop;
  1088.     end Do_Timing_Run;
  1089.  
  1090.  
  1091.     procedure Timer is
  1092.       Results : Results_Type (1..Test_Repetitions);
  1093.       Overhead_Results : Results_Type (1..Test_Repetitions);
  1094.     begin 
  1095.       Determine_Necessary_Iterations;
  1096.       Do_Timing_Run (Results, Overhead_Results);
  1097.       Print_Results (Results, Overhead_Results, Test_Repetitions, Iterations);
  1098.     end Timer;
  1099.  
  1100.     end Benchmark;
  1101.     Ada Benchmark Suite Version 1.0                              Page A-12
  1102.  
  1103.  
  1104.     A.8  WALL_CLOCK_CPU_BODY.ADA
  1105.  
  1106.     The following is a machine independent listing of the body for package Cpu:
  1107.  
  1108.  
  1109.  
  1110.     --  this is a machine independent dummy package for reporting the amount of
  1111.     --  CPU time used. It actually reports the elapsed time
  1112.     with CALENDAR;  use CALENDAR;
  1113.     with TEXT_IO;   use TEXT_IO;
  1114.     package body Cpu is
  1115.       Base_Time : constant CALENDAR.TIME := CALENDAR.CLOCK;
  1116.  
  1117.     function Clock return Time is
  1118.       Now : constant CALENDAR.TIME := CALENDAR.CLOCK;
  1119.     begin
  1120.       return Cpu.Time (Now - Base_Time);
  1121.     end Clock;
  1122.  
  1123.     function "-" (Stop_Time, Start_Time : Time) return DURATION is
  1124.     begin
  1125.       return DURATION (DURATION (Stop_Time) - DURATION (Start_Time));
  1126.     end "-";
  1127.  
  1128.     begin
  1129.       PUT_LINE ("NOTE: CPU Time is actually ELAPSED time!!!");
  1130.     end Cpu;
  1131.  
  1132.  
  1133.     Ada Benchmark Suite Version 1.0                              Page A-13
  1134.  
  1135.  
  1136.     A.9  PART1SPEC.ADA
  1137.  
  1138.     The following is a listing of the specification for the package Part_1:
  1139.  
  1140.  
  1141.  
  1142.     ---- test section 1
  1143.  
  1144.     package Part1 is
  1145.       Title : constant STRING := "task activation/termination";
  1146.       procedure Do_Test;
  1147.     end Part1;
  1148.     Ada Benchmark Suite Version 1.0                              Page A-14
  1149.  
  1150.  
  1151.     A.10  PART1.ADA
  1152.  
  1153.     The following is a listing of the body for the package Part_1:
  1154.  
  1155.  
  1156.  
  1157.     ---- test section 1 - task activation/termination
  1158.     with TEXT_IO, Benchmark;
  1159.     use  TEXT_IO;
  1160.     package body Part1 is
  1161.  
  1162.     procedure Do_Test is
  1163.  
  1164.         procedure Task_Activation (N : in NATURAL) is
  1165.           -- this procedure declares N tasks locally - timing this procedure
  1166.           -- will time 1 procedure call and N task activations/terminations
  1167.  
  1168.           task type Empty_Task;
  1169.  
  1170.           Lots_Of_Tasks : array (1 .. N) of Empty_Task;
  1171.  
  1172.           task body Empty_Task is
  1173.           begin
  1174.             null;
  1175.           end  Empty_Task;
  1176.  
  1177.         begin
  1178.           null;
  1179.         end Task_Activation;
  1180.  
  1181.  
  1182.         procedure Task_Allocation (N : in NATURAL) is
  1183.         -- this procedure allocates N tasks.  Since the task type is declared
  1184.         -- locally, deallocation of the task space should occur during the
  1185.         -- call to this procedure.
  1186.  
  1187.           task type Empty_Task;
  1188.  
  1189.           type Empty_Task_Ptr is access Empty_Task;
  1190.           Lots_Of_Tasks : array (1 .. N) of Empty_Task_Ptr;
  1191.  
  1192.           task body Empty_Task is
  1193.           begin
  1194.             null;
  1195.           end  Empty_Task;
  1196.  
  1197.         begin
  1198.           Lots_Of_Tasks := (1 .. N => new Empty_Task);
  1199.         end Task_Allocation;
  1200.  
  1201.         procedure Task_Activation2 (N : in NATURAL) is
  1202.           -- this procedure declares N tasks locally - timing this procedure
  1203.           -- will time 1 procedure call and N task activations/terminations
  1204.     Ada Benchmark Suite Version 1.0                              Page A-15
  1205.  
  1206.  
  1207.  
  1208.           task type Empty_Task is
  1209.              entry Dont_Call_Me;
  1210.           end Empty_Task;
  1211.  
  1212.           Lots_Of_Tasks : array (1 .. N) of Empty_Task;
  1213.  
  1214.           task body Empty_Task is
  1215.           begin
  1216.             select
  1217.               accept Dont_Call_Me;
  1218.             or
  1219.               terminate;
  1220.             end select;
  1221.           end  Empty_Task;
  1222.  
  1223.         begin
  1224.           null;
  1225.         end Task_Activation2;
  1226.  
  1227.  
  1228.     begin  -- Do_Test
  1229.         PUT_LINE ("               Task Activation/Termination Test");
  1230.         NEW_LINE;
  1231.         PUT_LINE ("This test times task activation and termination under a ");
  1232.         PUT_LINE ("variety of circumstances.");
  1233.  
  1234.                   --------------------------------------------
  1235.  
  1236.         NEW_LINE (2);
  1237.         PUT_LINE ("In this test an array of tasks is declared locally to a");
  1238.         PUT_LINE ("procedure.  Both the procedure and the task have null bodies.");
  1239.         NEW_LINE;
  1240.  
  1241.         declare
  1242.           package Local_Array_Pkg is new Benchmark 
  1243.                   (Item_Of_Interest => Task_Activation);
  1244.         begin
  1245.           Local_Array_Pkg.Timer;
  1246.         end;
  1247.  
  1248.                   --------------------------------------------
  1249.  
  1250.         NEW_LINE (2);
  1251.         PUT_LINE ("In this test an array of tasks is declared locally to a");
  1252.         PUT_LINE ("procedure.  The task uses the terminate option in a select");
  1253.         PUT_LINE ("statement to terminate.  The task is never called");
  1254.         NEW_LINE;
  1255.  
  1256.         declare
  1257.           package Terminate_Array_Pkg is new Benchmark
  1258.                   (Item_Of_Interest => Task_Activation2);
  1259.         begin
  1260.     Ada Benchmark Suite Version 1.0                              Page A-16
  1261.  
  1262.  
  1263.           Terminate_Array_Pkg.Timer;
  1264.         end;
  1265.  
  1266.                  ----------------------------------------
  1267.  
  1268.         NEW_LINE (2);
  1269.         PUT_LINE ("In this test an access type to a task is used to create a");
  1270.         PUT_LINE ("series of tasks.  The timing should include both allocation");
  1271.         PUT_LINE ("and deallocation of the task as well as activation and");
  1272.         PUT_LINE ("termination.");
  1273.         NEW_LINE;
  1274.  
  1275.         declare
  1276.           package Access_Type_Pkg is new Benchmark
  1277.                   (Item_Of_Interest => Task_Allocation);
  1278.         begin
  1279.           Access_Type_Pkg.Timer;
  1280.         end;
  1281.  
  1282.  
  1283.     exception
  1284.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  1285.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  1286.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  1287.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  1288.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  1289.       when others           => PUT_LINE ("*** test aborted due to exception");
  1290.  
  1291.     end Do_Test;
  1292.  
  1293.     end Part1;
  1294.     Ada Benchmark Suite Version 1.0                              Page A-17
  1295.  
  1296.  
  1297.     A.11  PART2SPEC.ADA
  1298.  
  1299.     The following is a listing of the specification for the package Part_2:
  1300.  
  1301.  
  1302.  
  1303.     ---- test section 2
  1304.  
  1305.     package Part2 is
  1306.       Title : constant STRING := "task communication";
  1307.       procedure Do_Test;
  1308.     end Part2;
  1309.     Ada Benchmark Suite Version 1.0                              Page A-18
  1310.  
  1311.  
  1312.     A.12  PART2.ADA
  1313.  
  1314.     The following is a listing of the body for the package Part_2:
  1315.  
  1316.  
  1317.  
  1318.     --- test section 2  --  task communication
  1319.     with TEXT_IO, Benchmark;
  1320.     use  TEXT_IO;
  1321.     package body Part2 is
  1322.  
  1323.     -- define the continue and terminate conditions for the tasks
  1324.     Continue_Item : constant := 1;
  1325.     Terminate_Item : constant := -1;
  1326.  
  1327.  
  1328.     procedure Do_Test is
  1329.  
  1330.  
  1331.       -- task types that are used in several tests
  1332.  
  1333.       task type Buffer_Type is
  1334.         entry Take_Item (Item : in INTEGER);
  1335.         entry Provide_Item (Item : out INTEGER);
  1336.       end Buffer_Type;
  1337.  
  1338.       task type Called_Consumer_Type is
  1339.             -- consumer is to take items until 
  1340.             -- a value of Terminate_Item is accepted. 
  1341.         entry Take_Item (Item : in INTEGER);
  1342.       end Called_Consumer_Type;
  1343.  
  1344.     pragma PAGE;
  1345.       
  1346.       task body Buffer_Type is
  1347.          type Buffer_Count is range 0 .. 2;
  1348.          subtype Buffer_Index is Buffer_Count range 1 .. Buffer_Count'LAST;
  1349.          Buf : array (Buffer_Index) of INTEGER;
  1350.          Head, Tail : Buffer_Index := Buffer_Index'FIRST;
  1351.          Count : Buffer_Count := 0;
  1352.       begin
  1353.         loop
  1354.           select
  1355.             when Count > 0 =>
  1356.             accept Provide_Item (Item : out INTEGER) do
  1357.               Item := Buf (Tail);
  1358.               Tail := (Tail mod Buffer_Index'LAST) + 1;
  1359.               Count := Count - 1;
  1360.             end Provide_Item;
  1361.           or
  1362.             when Count < Buffer_Count'LAST =>
  1363.             accept Take_Item (Item : in INTEGER) do
  1364.               Buf (Head) := Item;
  1365.     Ada Benchmark Suite Version 1.0                              Page A-19
  1366.  
  1367.  
  1368.               Head := (Head mod Buffer_Index'LAST) + 1;
  1369.               Count := Count + 1;
  1370.             end Take_Item;
  1371.           or
  1372.             terminate;
  1373.           end select;
  1374.         end loop;
  1375.       end Buffer_Type;
  1376.  
  1377.  
  1378.  
  1379.       task body Called_Consumer_Type is
  1380.         Item : INTEGER;
  1381.       begin
  1382.         loop
  1383.           accept Take_Item (Item : in INTEGER) do
  1384.             Called_Consumer_Type.Item := Item;
  1385.           end Take_Item;
  1386.  
  1387.           exit when Item = Terminate_Item;
  1388.  
  1389.         end loop;
  1390.       end Called_Consumer_Type;
  1391.     pragma PAGE;
  1392.  
  1393.     procedure Time_PC is
  1394.       Consumer : Called_Consumer_Type;
  1395.  
  1396.     begin
  1397.       NEW_LINE (2);
  1398.       PUT_LINE ("SIMPLE PC");
  1399.       PUT_LINE ("In this test the main task calls a consumer task.");
  1400.       PUT_LINE ("A simple integer value is the only data transferred");
  1401.       PUT_LINE ("and the consumer simply loops on the accept.");
  1402.       PUT_LINE ("Task activation/termination time is not included in the timing.");
  1403.       NEW_LINE;
  1404.  
  1405.       declare
  1406.         procedure Send_Item (Iterations : in NATURAL) is
  1407.         begin
  1408.           for J in 1..Iterations loop
  1409.             Consumer.Take_Item (Continue_Item);
  1410.           end loop;
  1411.         end Send_Item;
  1412.  
  1413.         package PC_Pkg is new Benchmark
  1414.                 (Item_Of_Interest => Send_Item);
  1415.       begin
  1416.         PC_Pkg.Timer;
  1417.         Consumer.Take_Item (Terminate_Item);
  1418.       end;
  1419.  
  1420.     exception
  1421.     Ada Benchmark Suite Version 1.0                              Page A-20
  1422.  
  1423.  
  1424.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  1425.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  1426.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  1427.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  1428.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  1429.       when others           => PUT_LINE ("*** test aborted due to exception");
  1430.     end Time_PC;
  1431.     pragma PAGE;
  1432.  
  1433.     procedure Time_PC2 is
  1434.  
  1435.       task type Called_Consumer_Type_With_Select is
  1436.             -- consumer is to take items until 
  1437.             -- a value of Terminate_Item is accepted. 
  1438.         entry Take_Item (Item : in INTEGER);
  1439.         entry Stop;  -- alternate entry for Take_Item
  1440.       end Called_Consumer_Type_With_Select;
  1441.  
  1442.       Consumer : Called_Consumer_Type_With_Select;
  1443.  
  1444.  
  1445.  
  1446.       task body Called_Consumer_Type_With_Select is
  1447.         Item : INTEGER;
  1448.       begin
  1449.         loop
  1450.           select
  1451.             accept Take_Item (Item : in INTEGER) do
  1452.               Called_Consumer_Type_With_Select.Item := Item;
  1453.             end Take_Item;
  1454.           or
  1455.             accept Stop do
  1456.                Item := Item;
  1457.             end Stop;
  1458.           end select;
  1459.  
  1460.           exit when Item = Terminate_Item;
  1461.  
  1462.         end loop;
  1463.       end Called_Consumer_Type_With_Select;
  1464.  
  1465.  
  1466.     begin
  1467.       NEW_LINE (2);
  1468.       PUT_LINE ("SELECTIVE WAIT");
  1469.       PUT_LINE ("In this test the main task calls a consumer task that");
  1470.       PUT_LINE ("consumes more than one type of item.");
  1471.       PUT_LINE ("A simple integer value is the only data transferred");
  1472.       PUT_LINE ("and the consumer simply loops on the selective accept.");
  1473.       PUT_LINE ("This test differs from the previous test in that the consumer");
  1474.       PUT_LINE ("uses a select statement to take the entry call where the");
  1475.       PUT_LINE ("select has two open alternatives.  In the previous case");
  1476.       PUT_LINE ("there was no select statement.");
  1477.     Ada Benchmark Suite Version 1.0                              Page A-21
  1478.  
  1479.  
  1480.       NEW_LINE;
  1481.  
  1482.       declare
  1483.         procedure Send_Item (Iterations : in NATURAL) is
  1484.         begin
  1485.           for J in 1..Iterations loop
  1486.             Consumer.Take_Item (Continue_Item);
  1487.           end loop;
  1488.         end Send_Item;
  1489.  
  1490.         package PC2_Pkg is new Benchmark
  1491.                 (Item_Of_Interest => Send_Item);
  1492.       begin
  1493.         PC2_Pkg.Timer;
  1494.         Consumer.Take_Item (Terminate_Item);
  1495.       end;
  1496.  
  1497.     exception
  1498.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  1499.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  1500.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  1501.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  1502.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  1503.       when others           => PUT_LINE ("*** test aborted due to exception");
  1504.     end Time_PC2;
  1505.     pragma PAGE;
  1506.  
  1507.     procedure Time_PC3 is
  1508.       Consumer : Called_Consumer_Type;
  1509.  
  1510.       task Producer is
  1511.            -- producer terminates upon accepting Terminate_Item.
  1512.         entry Produce (Num : in INTEGER);
  1513.         entry Have_Finished;
  1514.         
  1515.         -- Calls
  1516.            -- Consumer.Take_Item
  1517.       end Producer;
  1518.  
  1519.  
  1520.       task body Producer is
  1521.         Count : INTEGER;
  1522.       begin
  1523.         loop
  1524.           accept Produce (Num : in INTEGER) do
  1525.             Count := Num;
  1526.           end Produce;
  1527.  
  1528.           exit when Count = Terminate_Item;
  1529.  
  1530.           for I in 1 .. Count loop
  1531.             Consumer.Take_Item (Continue_Item);
  1532.           end loop;
  1533.     Ada Benchmark Suite Version 1.0                              Page A-22
  1534.  
  1535.  
  1536.  
  1537.           accept Have_Finished;
  1538.         end loop;
  1539.       end Producer;
  1540.  
  1541.       
  1542.     begin
  1543.       NEW_LINE (2);
  1544.       PUT_LINE ("PC");
  1545.       PUT_LINE ("In this test a producer task communicates with a consumer task");
  1546.       PUT_LINE ("directly. This timing should be similar to the simple PC tests.");
  1547.       PUT_LINE ("Interaction with the main task takes place only at the beginning");
  1548.       PUT_LINE ("and at the end.");
  1549.       PUT_LINE ("Total number of task interactions is N+2");
  1550.       NEW_LINE;
  1551.  
  1552.       declare
  1553.         procedure Tell_Producer (Iterations : in NATURAL) is
  1554.         begin
  1555.           Producer.Produce (Iterations);
  1556.           Producer.Have_Finished;
  1557.         end Tell_Producer;
  1558.  
  1559.         package PC3_Pkg is new Benchmark
  1560.                 (Item_Of_Interest => Tell_Producer);
  1561.  
  1562.       begin
  1563.         PC3_Pkg.Timer;
  1564.         Producer.Produce (Terminate_Item);
  1565.         Consumer.Take_Item (Terminate_Item);
  1566.       end;
  1567.  
  1568.     exception
  1569.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  1570.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  1571.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  1572.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  1573.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  1574.       when others           => PUT_LINE ("*** test aborted due to exception");
  1575.     end Time_PC3;
  1576.     pragma PAGE;
  1577.  
  1578.     procedure Time_PBC is
  1579.       Buffer : Buffer_Type;
  1580.  
  1581.  
  1582.       task type Calling_Consumer_Type is
  1583.             -- consumer is to take items until 
  1584.             -- a value of Terminate_Item is received. 
  1585.         entry Stop_On_Number (Num : in INTEGER); 
  1586.  
  1587.         -- Calls
  1588.            -- Buffer.Provide_Item
  1589.     Ada Benchmark Suite Version 1.0                              Page A-23
  1590.  
  1591.  
  1592.       end Calling_Consumer_Type;
  1593.  
  1594.       Consumer : Calling_Consumer_Type;
  1595.  
  1596.  
  1597.       task Producer is
  1598.         entry Produce (Num : in INTEGER);
  1599.         entry Have_Finished;
  1600.         -- Calls
  1601.            -- Buffer.Take_Item
  1602.       end Producer;
  1603.  
  1604.  
  1605.       task body Producer is
  1606.         Count : INTEGER;
  1607.       begin
  1608.         loop
  1609.           accept Produce (Num : in INTEGER) do
  1610.             Count := Num;
  1611.           end Produce;
  1612.  
  1613.           exit when Count = Terminate_Item;
  1614.  
  1615.           for I in 1 .. Count loop
  1616.             Buffer.Take_Item (Continue_Item);
  1617.           end loop;
  1618.  
  1619.           accept Have_Finished;
  1620.         end loop;
  1621.       end Producer;
  1622.  
  1623.  
  1624.       task body Calling_Consumer_Type is
  1625.         Item,
  1626.         Count : INTEGER;
  1627.       begin
  1628.         loop
  1629.           Accept Stop_On_Number (Num : in INTEGER) do
  1630.             Count := Num;
  1631.           end Stop_On_Number;
  1632.  
  1633.           exit when Count = Terminate_Item;
  1634.  
  1635.           for I in 1..Count loop
  1636.             Buffer.Provide_Item (Item);
  1637.           end loop;
  1638.         end loop;
  1639.       end Calling_Consumer_Type;
  1640.  
  1641.  
  1642.     begin
  1643.       NEW_LINE (2);
  1644.       PUT_LINE ("PBC");
  1645.     Ada Benchmark Suite Version 1.0                              Page A-24
  1646.  
  1647.  
  1648.       PUT_LINE ("In this test a producer task communicates with a consumer task");
  1649.       PUT_LINE ("indirectly through a bounded buffer (buffer size = 2).");
  1650.       PUT_LINE ("Interaction with the main task takes place only at the beginning");
  1651.       PUT_LINE ("and at the end.");
  1652.       PUT_LINE ("Total number of task interactions is 2N+3.");
  1653.       NEW_LINE;
  1654.  
  1655.       declare
  1656.         procedure Tell_PC (Iterations : NATURAL) is
  1657.         begin
  1658.           Producer.Produce (Iterations);
  1659.           Consumer.Stop_On_Number (Iterations);
  1660.           Producer.Have_Finished;
  1661.         end Tell_PC;
  1662.  
  1663.         package PBC_Pkg is new Benchmark
  1664.                 (Item_Of_Interest => Tell_PC);
  1665.  
  1666.       begin
  1667.         PBC_Pkg.Timer;
  1668.         Producer.Produce (Terminate_Item);
  1669.         Consumer.Stop_On_Number (Terminate_Item);
  1670.       end;
  1671.  
  1672.     exception
  1673.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  1674.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  1675.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  1676.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  1677.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  1678.       when others           => PUT_LINE ("*** test aborted due to exception");
  1679.     end Time_PBC;
  1680.     pragma PAGE;
  1681.  
  1682.     procedure Time_PBTC is
  1683.       Buffer      : Buffer_Type;
  1684.       Consumer    : Called_Consumer_Type;
  1685.  
  1686.       task Producer is
  1687.         entry Produce (Num : in INTEGER);
  1688.         entry Have_Finished;
  1689.  
  1690.         -- Calls
  1691.            -- Buffer.Take_Item
  1692.       end Producer;
  1693.  
  1694.       
  1695.       task Transporter is
  1696.         -- Calls
  1697.            -- Buffer.Provide_Item
  1698.            -- Consumer.Take_Item
  1699.       end Transporter;
  1700.  
  1701.     Ada Benchmark Suite Version 1.0                              Page A-25
  1702.  
  1703.  
  1704.  
  1705.       task body Transporter is
  1706.         Item : INTEGER;
  1707.       begin
  1708.         loop
  1709.           Buffer.Provide_Item (Item);
  1710.           Consumer.Take_Item (Item);
  1711.         end loop;
  1712.       end Transporter;
  1713.  
  1714.  
  1715.       task body Producer is
  1716.         Count : INTEGER;
  1717.       begin
  1718.         loop
  1719.           accept Produce (Num : in INTEGER) do
  1720.             Count := Num;
  1721.           end Produce;
  1722.  
  1723.           exit when Count = Terminate_Item;
  1724.  
  1725.           for I in 1 .. Count loop
  1726.             Buffer.Take_Item (Continue_Item);
  1727.           end loop;
  1728.  
  1729.           accept Have_Finished;
  1730.         end loop;
  1731.       end Producer;
  1732.  
  1733.     begin
  1734.       NEW_LINE (2);
  1735.       PUT_LINE ("PBTC");
  1736.       PUT_LINE ("In this test a producer task communicates with a consumer task");
  1737.       PUT_LINE ("indirectly through a bounded buffer (buffer size = 2) with");
  1738.       PUT_LINE ("a transporter between the buffer and the consumer.");
  1739.       PUT_LINE ("Interaction with the main task takes place only at the beginning");
  1740.       PUT_LINE ("and at the end.");
  1741.       PUT_LINE ("Total number of task interactions is 3N+2.");
  1742.       NEW_LINE;
  1743.  
  1744.       declare
  1745.         procedure Tell_Producer (Iterations : in NATURAL) is
  1746.         begin
  1747.           Producer.Produce (Iterations);
  1748.           Producer.Have_Finished;
  1749.         end Tell_Producer;
  1750.  
  1751.         package PBTC_Pkg is new Benchmark
  1752.                 (Item_Of_Interest => Tell_Producer);
  1753.  
  1754.       begin
  1755.         PBTC_Pkg.Timer;
  1756.         Producer.Produce (Terminate_Item);         
  1757.     Ada Benchmark Suite Version 1.0                              Page A-26
  1758.  
  1759.  
  1760.         Consumer.Take_Item (Terminate_Item);  
  1761.         abort Transporter;            -- do this so buffer will die on its own
  1762.       end;
  1763.  
  1764.     exception
  1765.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  1766.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  1767.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  1768.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  1769.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  1770.       when others           => PUT_LINE ("*** test aborted due to exception");
  1771.     end Time_PBTC;
  1772.     pragma PAGE;
  1773.  
  1774.     procedure Time_PTBTC is
  1775.       Buffer      : Buffer_Type;
  1776.       Consumer    : Called_Consumer_Type;
  1777.  
  1778.       task Producer is
  1779.         entry Produce (Num : in INTEGER);
  1780.         entry Provide_Item (Item : out INTEGER);
  1781.         entry Have_Finished;
  1782.       end Producer;
  1783.  
  1784.       
  1785.       task C_Transporter is
  1786.         -- Calls
  1787.            -- Buffer.Provide_Item
  1788.            -- Consumer.Take_Item
  1789.       end C_Transporter;
  1790.  
  1791.  
  1792.       task body C_Transporter is
  1793.         Item : INTEGER;
  1794.       begin
  1795.         loop
  1796.           Buffer.Provide_Item (Item);
  1797.           Consumer.Take_Item (Item);
  1798.         end loop;
  1799.       end C_Transporter;
  1800.  
  1801.       
  1802.       task P_Transporter is
  1803.         -- Calls
  1804.            -- Producer.Provide_Item
  1805.            -- Buffer.Take_Item
  1806.       end P_Transporter;
  1807.  
  1808.  
  1809.       task body P_Transporter is
  1810.         Item : INTEGER;
  1811.       begin
  1812.         loop
  1813.     Ada Benchmark Suite Version 1.0                              Page A-27
  1814.  
  1815.  
  1816.           Producer.Provide_Item (Item);
  1817.           Buffer.Take_Item (Item);
  1818.         end loop;
  1819.       end P_Transporter;
  1820.  
  1821.  
  1822.       task body Producer is
  1823.         Count : INTEGER;
  1824.       begin
  1825.         loop
  1826.           accept Produce (Num : in INTEGER) do
  1827.             Count := Num;
  1828.           end Produce;
  1829.  
  1830.           exit when Count = Terminate_Item;
  1831.  
  1832.           for I in 1 .. Count loop
  1833.             accept Provide_Item (Item : out INTEGER) do
  1834.                Item := Continue_Item;
  1835.             end Provide_Item;
  1836.           end loop;
  1837.  
  1838.           accept Have_Finished;
  1839.  
  1840.         end loop;
  1841.       end Producer;
  1842.  
  1843.     begin
  1844.       NEW_LINE (2);
  1845.       PUT_LINE ("PTBTC");
  1846.       PUT_LINE ("In this test a producer task communicates with a consumer task");
  1847.       PUT_LINE ("indirectly through a bounded buffer (buffer size = 2) with");
  1848.       PUT_LINE ("a transporter for both the producer and the consumer.");
  1849.       PUT_LINE ("Interaction with the main task takes place only at the beginning");
  1850.       PUT_LINE ("and at the end.");
  1851.       PUT_LINE ("Total number of task interactions is 4N+2.");
  1852.       NEW_LINE;
  1853.  
  1854.       declare
  1855.         procedure Tell_Producer (Iterations : in NATURAL) is
  1856.         begin
  1857.           Producer.Produce (Iterations);
  1858.           Producer.Have_Finished;
  1859.         end Tell_Producer;
  1860.  
  1861.         package PTBTC_Pkg is new Benchmark
  1862.                 (Item_Of_Interest => Tell_Producer);
  1863.       begin
  1864.         PTBTC_Pkg.Timer;
  1865.         Producer.Produce (Terminate_Item);         
  1866.         Consumer.Take_Item (Terminate_Item); 
  1867.         abort P_Transporter, C_Transporter; -- do this so buffer will die on its own
  1868.       end;
  1869.     Ada Benchmark Suite Version 1.0                              Page A-28
  1870.  
  1871.  
  1872.  
  1873.     exception
  1874.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  1875.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  1876.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  1877.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  1878.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  1879.       when others           => PUT_LINE ("*** test aborted due to exception");
  1880.     end Time_PTBTC;
  1881.     pragma PAGE;
  1882.  
  1883.     procedure Time_Relay is
  1884.       Consumer    : Called_Consumer_Type;
  1885.       
  1886.  
  1887.       task Producer is
  1888.         entry Produce (Num : in INTEGER);
  1889.         entry Have_Finished;
  1890.  
  1891.         -- Calls
  1892.            -- Relay.Take_Item
  1893.       end Producer;
  1894.  
  1895.       
  1896.       task Relay is
  1897.         entry Take_Item (Item : in INTEGER);
  1898.  
  1899.         -- Calls
  1900.            -- Consumer.Take_Item
  1901.       end Relay;
  1902.  
  1903.  
  1904.       task body Relay is
  1905.         Item : INTEGER;
  1906.       begin
  1907.         loop
  1908.           accept Take_Item (Item : in INTEGER) do
  1909.             Relay.Item := Take_Item.Item;
  1910.           end Take_Item;
  1911.  
  1912.           exit when Item = Terminate_Item;
  1913.  
  1914.           Consumer.Take_Item (Item);
  1915.         end loop;
  1916.       end Relay;
  1917.  
  1918.  
  1919.       task body Producer is
  1920.         Count : INTEGER;
  1921.       begin
  1922.         loop
  1923.           accept Produce (Num : in INTEGER) do
  1924.             Count := Num;
  1925.     Ada Benchmark Suite Version 1.0                              Page A-29
  1926.  
  1927.  
  1928.           end Produce;
  1929.  
  1930.           exit when Count = Terminate_Item;
  1931.  
  1932.           for I in 1 .. Count loop
  1933.             Relay.Take_Item (Continue_Item);
  1934.           end loop;
  1935.      
  1936.           accept Have_Finished;
  1937.  
  1938.         end loop;
  1939.       end Producer;
  1940.  
  1941.     begin
  1942.       NEW_LINE (2);
  1943.       PUT_LINE ("RELAY");
  1944.       PUT_LINE ("In this test a producer task communicates with a consumer task");
  1945.       PUT_LINE ("indirectly through a relay.  In terms of the task communication");
  1946.       PUT_LINE ("model, this resembles the PBTC paradigm but in terms of");
  1947.       PUT_LINE ("performance it should resemble the PBC test.");
  1948.       PUT_LINE ("Interaction with the main task takes place only at the beginning");
  1949.       PUT_LINE ("and at the end.");
  1950.       PUT_LINE ("Total number of task interactions is 2N+2.");
  1951.       NEW_LINE;
  1952.  
  1953.       declare
  1954.         procedure Tell_Producer (Iterations : in NATURAL) is
  1955.         begin
  1956.           Producer.Produce (Iterations);
  1957.           Producer.Have_Finished;
  1958.         end Tell_Producer;
  1959.  
  1960.         package Relay_Pkg is new Benchmark
  1961.                 (Item_Of_Interest => Tell_Producer);
  1962.       begin
  1963.         Relay_Pkg.Timer;
  1964.         Producer.Produce (Terminate_Item);         
  1965.         Consumer.Take_Item (Terminate_Item);  
  1966.         Relay.Take_Item (Terminate_Item);          
  1967.       end;
  1968.  
  1969.     exception
  1970.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  1971.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  1972.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  1973.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  1974.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  1975.       when others           => PUT_LINE ("*** test aborted due to exception");
  1976.     end Time_Relay;
  1977.     pragma PAGE;
  1978.  
  1979.     begin
  1980.       PUT_LINE ("               Task Communication");
  1981.     Ada Benchmark Suite Version 1.0                              Page A-30
  1982.  
  1983.  
  1984.       NEW_LINE;
  1985.       PUT_LINE ("This test times task to task communication in order to determine");
  1986.       PUT_LINE ("the cost of the various task communication models.  Task");
  1987.       PUT_LINE ("activation and termination is not included in the timings.");
  1988.       Time_PC;
  1989.       Time_PC2;
  1990.       Time_PC3;
  1991.       Time_PBC;
  1992.       Time_PBTC;
  1993.       Time_PTBTC;
  1994.       Time_Relay;
  1995.  
  1996.     exception
  1997.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  1998.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  1999.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  2000.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  2001.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  2002.       when others           => PUT_LINE ("*** test aborted due to exception");
  2003.  
  2004.     end Do_Test;
  2005.  
  2006.     end Part2;
  2007.  
  2008.     Ada Benchmark Suite Version 1.0                              Page A-31
  2009.  
  2010.  
  2011.     A.13  PART3SPEC.ADA
  2012.  
  2013.     The following is a listing of the specification for the package Part_3:
  2014.  
  2015.  
  2016.  
  2017.     ---- test section 3
  2018.  
  2019.     package Part3 is
  2020.       Title : constant STRING := "task optimization";
  2021.       procedure Do_Test;
  2022.     end Part3;
  2023.     Ada Benchmark Suite Version 1.0                              Page A-32
  2024.  
  2025.  
  2026.     A.14  PART3.ADA
  2027.  
  2028.     The following is a listing of the body for the package Part_3:
  2029.  
  2030.  
  2031.  
  2032.     ------ test section 3 - task optimization techniques
  2033.     with TEXT_IO, Benchmark;
  2034.     use  TEXT_IO;
  2035.     package body Part3 is
  2036.  
  2037.     -- define the continue and terminate conditions for the tasks.
  2038.     Continue_Item : constant := 1;
  2039.     Terminate_Item : constant := -1;
  2040.  
  2041.     procedure Do_Test is
  2042.  
  2043.     procedure Time_Monitor is
  2044.  
  2045.       task General_Task is
  2046.         entry Take_Item (Item : in INTEGER);
  2047.         entry Provide_Item (Item : out INTEGER);
  2048.       end General_Task;
  2049.  
  2050.       task Monitor is
  2051.         entry Take_Item (Item : in INTEGER);
  2052.         entry Provide_Item (Item : out INTEGER);
  2053.       end Monitor;
  2054.  
  2055.       
  2056.       task body General_Task is
  2057.         Local : INTEGER;
  2058.       begin
  2059.         loop
  2060.           select
  2061.             accept Take_Item (Item : in INTEGER) do
  2062.               Local := Item;
  2063.             end Take_Item;
  2064.             Local := Local + 1;  -- the only difference is where this line is
  2065.           or
  2066.             accept Provide_Item (Item : out INTEGER) do
  2067.               Item := Local;
  2068.             end Provide_Item;
  2069.           or
  2070.             terminate;
  2071.           end select;
  2072.         end loop;
  2073.       end General_Task;
  2074.  
  2075.       
  2076.       task body Monitor is
  2077.         Local : INTEGER;
  2078.       begin
  2079.     Ada Benchmark Suite Version 1.0                              Page A-33
  2080.  
  2081.  
  2082.         loop
  2083.           select
  2084.             accept Take_Item (Item : in INTEGER) do
  2085.               Local := Item;
  2086.               Local := Local + 1;  -- the only difference is where this line is
  2087.             end Take_Item;
  2088.           or
  2089.             accept Provide_Item (Item : out INTEGER) do
  2090.               Item := Local;
  2091.             end Provide_Item;
  2092.           or
  2093.             terminate;
  2094.           end select;
  2095.         end loop;
  2096.       end Monitor;
  2097.  
  2098.  
  2099.     begin
  2100.       NEW_LINE (2);
  2101.       PUT_LINE ("MONITOR");
  2102.       PUT_LINE ("A task that contains no code outside of the accept bodies");
  2103.       PUT_LINE ("is considered to be a monitor.  It is possible to eliminate");
  2104.       PUT_LINE ("such a task by protecting the task entries with semaphores.");
  2105.       PUT_LINE ("In this test the main task interacts with a monitor and with");
  2106.       PUT_LINE ("a more general task in order to determine if this optimization");
  2107.       PUT_LINE ("is performed.  The monitor is the overhead item and the general");
  2108.       PUT_LINE ("task is the tested item.  If the net cpu is negative or near");
  2109.       PUT_LINE ("zero, it can be assumed that the optimization is not done.");
  2110.       NEW_LINE;
  2111.  
  2112.       declare
  2113.         procedure Send_To_Monitor (Iterations : in NATURAL) is
  2114.         begin
  2115.           for J in 1..Iterations loop
  2116.             Monitor.Take_Item (Continue_Item);
  2117.           end loop;
  2118.         end Send_To_Monitor;
  2119.  
  2120.         procedure Send_To_General (Iterations : in NATURAL) is
  2121.         begin
  2122.           for J in 1..Iterations loop
  2123.             General_Task.Take_Item (Continue_Item);
  2124.           end loop;
  2125.         end Send_To_General;
  2126.  
  2127.         package Monitor_Pkg is new Benchmark
  2128.                 (Overhead => Send_To_Monitor,
  2129.                  Item_Of_Interest => Send_To_General);
  2130.  
  2131.       begin
  2132.         Monitor_Pkg.Timer;
  2133.       end;
  2134.     end Time_Monitor;
  2135.     Ada Benchmark Suite Version 1.0                              Page A-34
  2136.  
  2137.  
  2138.     pragma PAGE;
  2139.  
  2140.     procedure Time_Single_Accept_Body is
  2141.  
  2142.       task Single_Accept is
  2143.         entry Take_Item (Item : in INTEGER);
  2144.         entry Stop;
  2145.       end Single_Accept;
  2146.  
  2147.       task body Single_Accept is
  2148.       begin
  2149.         loop
  2150.           select 
  2151.             accept Take_Item (Item : in INTEGER) do
  2152.               if Item = 0 then
  2153.                 PUT_LINE ("error in test (single accept)");
  2154.               end if;
  2155.             end Take_Item;
  2156.           or
  2157.             accept Stop;
  2158.             exit;
  2159.           end select;
  2160.         end loop;
  2161.       end Single_Accept;
  2162.  
  2163.  
  2164.       task Multiple_Accept is
  2165.         entry Take_Item (Item : in INTEGER);
  2166.         entry Stop;
  2167.       end Multiple_Accept;
  2168.  
  2169.       task body Multiple_Accept is
  2170.       begin
  2171.         loop
  2172.           select 
  2173.             accept Take_Item (Item : in INTEGER) do
  2174.               if Item = 0 then
  2175.                 PUT_LINE ("error in test (single accept)");
  2176.               end if;
  2177.             end Take_Item;
  2178.           or
  2179.             accept Stop;
  2180.             exit;
  2181.           end select;
  2182.  
  2183.              -- repeat select statement to create the multiple accept bodies
  2184.           select 
  2185.             accept Take_Item (Item : in INTEGER) do
  2186.               if Item = 0 then
  2187.                 PUT_LINE ("error in test (single accept)");
  2188.               end if;
  2189.             end Take_Item;
  2190.           or
  2191.     Ada Benchmark Suite Version 1.0                              Page A-35
  2192.  
  2193.  
  2194.             accept Stop;
  2195.             exit;
  2196.           end select;
  2197.         end loop;
  2198.       end Multiple_Accept;
  2199.  
  2200.  
  2201.     begin
  2202.       NEW_LINE (2);
  2203.       PUT_LINE ("SINGLE ACCEPT BODIES");
  2204.       PUT_LINE ("In the case where a task entry has a single accept body there");
  2205.       PUT_LINE ("is no need for the indirect referencing that may be used when");
  2206.       PUT_LINE ("a single entry has multiple accept bodies.");
  2207.       PUT_LINE ("This test checks to see if calls to entrys that have a ");
  2208.       PUT_LINE ("single accept body are more efficient than when multiple ");
  2209.       PUT_LINE ("accept bodies are used.  The single accept body is the ");
  2210.       PUT_LINE ("overhead item and the multiple accept body is the tested item.");
  2211.       PUT_LINE ("If the net cpu is negative or near zero, it can be assumed ");
  2212.       PUT_LINE ("that the optimization is not done.");
  2213.       NEW_LINE;
  2214.  
  2215.       declare
  2216.         procedure Send_To_Single (Iterations : in NATURAL) is
  2217.         begin
  2218.           for J in 1..Iterations loop
  2219.             Single_Accept.Take_Item (Continue_Item);
  2220.           end loop;
  2221.         end Send_To_Single;
  2222.  
  2223.         procedure Send_To_Multiple (Iterations : in NATURAL) is
  2224.         begin
  2225.           for J in 1..Iterations loop
  2226.             Multiple_Accept.Take_Item (Continue_Item);
  2227.           end loop;
  2228.         end Send_To_Multiple;
  2229.  
  2230.         package Accept_Pkg is new Benchmark
  2231.                 (Overhead => Send_To_Single,
  2232.                  Item_Of_Interest => Send_To_Multiple);
  2233.  
  2234.       begin
  2235.         Accept_Pkg.Timer;
  2236.         Single_Accept.Stop;   -- kill off the tasks
  2237.         Multiple_Accept.Stop;
  2238.       end;
  2239.     end Time_Single_Accept_Body;
  2240.     pragma PAGE;
  2241.  
  2242.     begin  -- Do_Test
  2243.       PUT_LINE ("               Task Optimizations");
  2244.       NEW_LINE;
  2245.       PUT_LINE ("This test determines if the implementation optimizes various");
  2246.       PUT_LINE ("special cases of tasking.  The specific optimizations being");
  2247.     Ada Benchmark Suite Version 1.0                              Page A-36
  2248.  
  2249.  
  2250.       PUT_LINE ("tested for are machine independent optimizations that have been");
  2251.       PUT_LINE ("discussed in the Ada literature. For each specific optimization");
  2252.       PUT_LINE ("the general case and the special case is timed.");
  2253.       PUT_LINE ("If the special case is significantly");
  2254.       PUT_LINE ("faster than the general case then it is assumed that the");
  2255.       PUT_LINE ("optimization technique is employed.");
  2256.  
  2257.       Time_Monitor;
  2258.       Time_Single_Accept_Body;
  2259.  
  2260.  
  2261.     exception
  2262.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  2263.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  2264.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  2265.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  2266.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  2267.       when others           => PUT_LINE ("*** test aborted due to exception");
  2268.  
  2269.     end Do_Test;
  2270.     end Part3;
  2271.     Ada Benchmark Suite Version 1.0                              Page A-37
  2272.  
  2273.  
  2274.     A.15  PART4SPEC.ADA
  2275.  
  2276.     The following is a listing of the specification for the package Part_4:
  2277.  
  2278.  
  2279.  
  2280.     ---- test section 4 - exception propagation
  2281.  
  2282.     package Part4 is
  2283.       Title : constant STRING := "exception propagation";
  2284.       procedure Do_Test;
  2285.     end Part4;
  2286.     Ada Benchmark Suite Version 1.0                              Page A-38
  2287.  
  2288.  
  2289.     A.16  PART4.ADA
  2290.  
  2291.     The following is a listing of the body for the package Part_4:
  2292.  
  2293.  
  2294.  
  2295.     ---------- test section 4  -- exception propagation
  2296.     with TEXT_IO, Benchmark;
  2297.     use  TEXT_IO;
  2298.     package body Part4 is
  2299.  
  2300.     procedure Do_Test is
  2301.  
  2302.     procedure Time_Simple_Exception is
  2303.     begin
  2304.       NEW_LINE (2);
  2305.       PUT_LINE ("EXCEPTION IN BLOCK");
  2306.       PUT_LINE ("In this test an exception is raised and handled in the same");
  2307.       PUT_LINE ("block.  The user defined exception is declared local to the");
  2308.       PUT_LINE ("block where it is raised.  The same block is timed without");
  2309.       PUT_LINE ("the exception being raised so the exception handling time can");
  2310.       PUT_LINE ("be determined.");
  2311.  
  2312.       declare 
  2313.         procedure Do_Raise (Iterations : in NATURAL) is
  2314.         begin
  2315.           for J in 1..Iterations loop
  2316.             declare
  2317.               Exc : exception;
  2318.             begin
  2319.               raise Exc;
  2320.               PUT_LINE ("ERROR: exception not raised as it should.");
  2321.               raise PROGRAM_ERROR;
  2322.             exception
  2323.               when Exc =>
  2324.                    null;
  2325.             end;
  2326.           end loop;
  2327.         end Do_Raise;
  2328.  
  2329.         procedure Dont_Raise (Iterations : in NATURAL) is
  2330.         begin
  2331.           for J in 1..Iterations loop
  2332.             declare
  2333.               Exc : exception;
  2334.             begin
  2335.               null;
  2336.             exception
  2337.               when Exc =>
  2338.                 PUT_LINE ("ERROR: exception improperly raised.");
  2339.             end;
  2340.           end loop;
  2341.         end Dont_Raise;
  2342.     Ada Benchmark Suite Version 1.0                              Page A-39
  2343.  
  2344.  
  2345.  
  2346.         package Simple_Exception_Pkg is new Benchmark
  2347.                 (Overhead => Dont_Raise,
  2348.                  Item_Of_Interest => Do_Raise);
  2349.  
  2350.       begin
  2351.         Simple_Exception_Pkg.Timer;
  2352.       end;
  2353.     end Time_Simple_Exception;
  2354.     pragma PAGE;
  2355.  
  2356.     procedure Time_Procedure_Exception is
  2357.       Exc         : exception;
  2358.  
  2359.         -- raise Exc if the parameter is true otherwise do nothing
  2360.       procedure Raise_Exc (Do_It : in BOOLEAN) is
  2361.       begin
  2362.         if Do_It then
  2363.           raise Exc;
  2364.         end if;
  2365.  
  2366.         if Do_It then  -- make sure the exception was raised
  2367.           PUT_LINE ("ERROR: exception not properly raised.");
  2368.           raise PROGRAM_ERROR;
  2369.         end if;
  2370.       end Raise_Exc;
  2371.  
  2372.     begin
  2373.       NEW_LINE (2);
  2374.       PUT_LINE ("EXCEPTION WITHIN PROCEDURE");
  2375.       PUT_LINE ("In this test an exception is raised in a procedure and");
  2376.       PUT_LINE ("handled by the caller. The same procedure call is timed without");
  2377.       PUT_LINE ("the exception being raised so the exception handling time can");
  2378.       PUT_LINE ("be determined.");
  2379.  
  2380.       declare
  2381.         procedure Do_Raise (Iterations : in NATURAL) is
  2382.         begin
  2383.           for J in 1..Iterations loop
  2384.             begin
  2385.               Raise_Exc (TRUE);
  2386.             exception -- handle exception raised by the procedure
  2387.               when Exc =>
  2388.                     null;
  2389.             end;
  2390.           end loop;
  2391.         end Do_Raise;
  2392.  
  2393.         procedure Dont_Raise (Iterations : in NATURAL) is
  2394.         begin
  2395.           for J in 1..Iterations loop
  2396.             begin
  2397.               Raise_Exc (FALSE);
  2398.     Ada Benchmark Suite Version 1.0                              Page A-40
  2399.  
  2400.  
  2401.             exception
  2402.               when Exc =>
  2403.                 PUT_LINE ("ERROR: exception improperly raised.");
  2404.             end;
  2405.           end loop;
  2406.         end Dont_Raise;
  2407.  
  2408.         package Procedure_Exception_Pkg is new Benchmark
  2409.                 (Overhead => Dont_Raise,
  2410.                  Item_Of_Interest => Do_Raise);
  2411.  
  2412.       begin
  2413.         Procedure_Exception_Pkg.Timer;
  2414.       end;
  2415.     end Time_Procedure_Exception;
  2416.     pragma PAGE;
  2417.  
  2418.     procedure Time_Task_Propagation is
  2419.       Exc         : exception;
  2420.  
  2421.       task Some_Task is
  2422.         entry Raise_Exc (Do_It : in BOOLEAN);
  2423.       end Some_Task;
  2424.  
  2425.       task body Some_Task is
  2426.       begin
  2427.         loop
  2428.           begin
  2429.             select
  2430.               accept Raise_Exc (Do_It : in BOOLEAN) do
  2431.                 -- raise Exc if the parameter is true otherwise do nothing
  2432.                 if Do_It then
  2433.                   raise Exc;
  2434.                 end if;
  2435.       
  2436.                 if Do_It then  -- make sure the exception was raised
  2437.                   PUT_LINE ("ERROR: exception not properly raised.");
  2438.                   raise PROGRAM_ERROR;
  2439.                 end if;
  2440.               end Raise_Exc;
  2441.             or 
  2442.               terminate;
  2443.             end select;
  2444.           exception
  2445.             when Exc => null;
  2446.           end;
  2447.         end loop;
  2448.       end Some_Task;
  2449.  
  2450.     begin
  2451.       NEW_LINE (2);
  2452.       PUT_LINE ("EXCEPTION IN ENTRY");
  2453.       PUT_LINE ("In this test an exception is raised during a rendezvous.");
  2454.     Ada Benchmark Suite Version 1.0                              Page A-41
  2455.  
  2456.  
  2457.       PUT_LINE ("The exception is handled in both the calling environment and");
  2458.       PUT_LINE ("in the task.  The same entry is timed without");
  2459.       PUT_LINE ("the exception being raised so the exception handling time can");
  2460.       PUT_LINE ("be determined.");
  2461.  
  2462.       declare
  2463.         procedure Do_Raise (Iterations : in NATURAL) is
  2464.         begin
  2465.           for J in 1..Iterations loop
  2466.             begin
  2467.               Some_Task.Raise_Exc (TRUE);
  2468.             exception -- handle exception raised by the procedure
  2469.               when Exc =>
  2470.                     null;
  2471.             end;
  2472.           end loop;
  2473.         end Do_Raise;
  2474.  
  2475.         procedure Dont_Raise (Iterations : in NATURAL) is
  2476.         begin
  2477.           for J in 1..Iterations loop
  2478.             begin
  2479.               Some_Task.Raise_Exc (FALSE);
  2480.             exception
  2481.               when Exc =>
  2482.                 PUT_LINE ("ERROR: exception improperly raised.");
  2483.             end;
  2484.           end loop;
  2485.         end Dont_Raise;
  2486.  
  2487.         package Task_Exception_Pkg is new Benchmark
  2488.                 (Overhead => Dont_Raise,
  2489.                  Item_Of_Interest => Do_Raise);
  2490.  
  2491.       begin
  2492.         Task_Exception_Pkg.Timer;
  2493.       end;
  2494.     end Time_Task_Propagation;
  2495.     pragma PAGE;
  2496.  
  2497.     begin  -- Do_Test
  2498.       PUT_LINE ("               Exception Propagation");
  2499.       NEW_LINE;
  2500.       PUT_LINE ("This test times exception propagation in various contexts");
  2501.       PUT_LINE ("including propagating an exception to a calling task during a");
  2502.       PUT_LINE ("rendezvous.");
  2503.  
  2504.       Time_Simple_Exception;
  2505.       Time_Procedure_Exception;
  2506.       Time_Task_Propagation;
  2507.  
  2508.     exception
  2509.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  2510.     Ada Benchmark Suite Version 1.0                              Page A-42
  2511.  
  2512.  
  2513.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  2514.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  2515.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  2516.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  2517.       when others           => PUT_LINE ("*** test aborted due to exception");
  2518.     end Do_Test;
  2519.     end Part4;
  2520.     Ada Benchmark Suite Version 1.0                              Page A-43
  2521.  
  2522.  
  2523.     A.17  PART5SPEC.ADA
  2524.  
  2525.     The following is a listing of the specification for the package Part_5:
  2526.  
  2527.  
  2528.  
  2529.     ---- test section 5
  2530.  
  2531.     package Part5 is
  2532.       Title : constant STRING := "task interaction";
  2533.       procedure Do_Test;
  2534.     end Part5;
  2535.     Ada Benchmark Suite Version 1.0                              Page A-44
  2536.  
  2537.  
  2538.     A.18  PART5.ADA
  2539.  
  2540.     The following is a listing of the body for the package Part_5:
  2541.  
  2542.  
  2543.  
  2544.     --- test section 5  --  task interaction
  2545.     with TEXT_IO, Benchmark;
  2546.     use  TEXT_IO;
  2547.     package body Part5 is
  2548.  
  2549.       -- define the continue and terminate conditions for the tasks
  2550.       Continue_Item : constant := 1;
  2551.       Terminate_Item : constant := -1;
  2552.  
  2553.       -- task types that are common to several tests
  2554.  
  2555.       task type Called_Consumer_Type_1 is
  2556.             -- consumer is to take items until 
  2557.             -- a value of Terminate_Item is accepted.
  2558.         entry Take_Item (Item : in INTEGER);
  2559.       end Called_Consumer_Type_1;
  2560.  
  2561.  
  2562.       task type Called_Consumer_Type_2 is
  2563.             -- consumer is to take items until 
  2564.             -- a value of Terminate_Item is accepted.
  2565.             -- However, enabling takes must be done first.
  2566.         entry Take_Item (Item : in INTEGER);
  2567.         entry Enable_Takes;
  2568.       end Called_Consumer_Type_2;
  2569.  
  2570.  
  2571.       task body Called_Consumer_Type_1 is
  2572.         Item : INTEGER;
  2573.       begin
  2574.         loop   
  2575.           accept Take_Item (Item : in INTEGER) do
  2576.             Called_Consumer_Type_1.Item := Item;
  2577.           end Take_Item;
  2578.  
  2579.           exit when Item = Terminate_Item;
  2580.  
  2581.         end loop;
  2582.       end Called_Consumer_Type_1;
  2583.  
  2584.       task body Called_Consumer_Type_2 is
  2585.         Item : INTEGER;
  2586.       begin
  2587.         accept Enable_Takes;
  2588.         loop   
  2589.           accept Take_Item (Item : in INTEGER) do
  2590.             Called_Consumer_Type_2.Item := Item;
  2591.     Ada Benchmark Suite Version 1.0                              Page A-45
  2592.  
  2593.  
  2594.           end Take_Item;
  2595.  
  2596.           exit when Item = Terminate_Item;
  2597.  
  2598.         end loop;
  2599.       end Called_Consumer_Type_2;
  2600.     pragma PAGE;
  2601.  
  2602.     procedure Do_Test is
  2603.  
  2604.     procedure Time_Procedure_Calls is
  2605.       Finished    : BOOLEAN := FALSE;
  2606.  
  2607.       procedure Take_Number (Num : in INTEGER) is
  2608.       begin
  2609.         -- note that Num is never 0.  The conditional recursion is to help
  2610.         -- prevent the compiler from making this procedure implicitly inline.
  2611.         if Num <= 0 then
  2612.            Take_Number (Num + 1);
  2613.         else
  2614.           Finished := Num = 1;
  2615.         end if;
  2616.       end Take_Number;
  2617.  
  2618.       procedure Give_Number (Iterations : in NATURAL) is
  2619.       begin
  2620.         for J in 1..Iterations loop
  2621.           Take_Number (1);
  2622.         end loop;
  2623.       end Give_Number;
  2624.  
  2625.     begin
  2626.       NEW_LINE (2);
  2627.       PUT_LINE ("PROCEDURE CALLING");
  2628.       PUT_LINE ("In this test the time to do a procedure call is measured");
  2629.       PUT_LINE ("so it can be compared to a task entry call.  The procedure");
  2630.       PUT_LINE ("contains a minimum amount of code - just enough to keep a");
  2631.       PUT_LINE ("compiler from thinking it can be eliminated.");
  2632.       NEW_LINE;
  2633.  
  2634.       declare
  2635.         package Procedure_Pkg is new Benchmark
  2636.                 (Item_Of_Interest => Give_Number);
  2637.       begin
  2638.         Procedure_Pkg.Timer;
  2639.       end;
  2640.  
  2641.     exception
  2642.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  2643.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  2644.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  2645.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  2646.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  2647.     Ada Benchmark Suite Version 1.0                              Page A-46
  2648.  
  2649.  
  2650.       when others           => PUT_LINE ("*** test aborted due to exception");
  2651.     end Time_Procedure_Calls;
  2652.     pragma PAGE;
  2653.  
  2654.     procedure Time_Conditional_Entry is
  2655.       Enabled_Task   : Called_Consumer_Type_1;
  2656.       Disabled_Task  : Called_Consumer_Type_2;
  2657.       Not_Accepted_Err,
  2658.       Accepted_Err : INTEGER := 0;
  2659.  
  2660.       procedure Not_Accepted (Iterations : in NATURAL) is
  2661.       begin
  2662.         for J in 1..Iterations-1 loop  -- -1 to account for Enable call
  2663.           select
  2664.             Disabled_Task.Take_Item (Continue_Item);
  2665.             Not_Accepted_Err := Not_Accepted_Err + 1;
  2666.           else
  2667.             null;
  2668.           end select;
  2669.         end loop;
  2670.       end Not_Accepted;
  2671.  
  2672.       procedure Accepted (Iterations : in NATURAL) is
  2673.       begin
  2674.         for J in 1..Iterations-1 loop  -- -1 to account for Enable call
  2675.           select
  2676.             Enabled_Task.Take_Item (Continue_Item);
  2677.           else
  2678.             Accepted_Err := Accepted_Err + 1;
  2679.           end select;
  2680.         end loop;
  2681.       end Accepted;
  2682.  
  2683.     begin
  2684.       NEW_LINE (2);
  2685.       PUT_LINE ("CONDITIONAL ENTRY");
  2686.       PUT_LINE ("In this test the main task calls a consumer task with a");
  2687.       PUT_LINE ("conditional entry call.  The test tries calls that are not");
  2688.       PUT_LINE ("accepted then tries calls that are accepted.");
  2689.       PUT_LINE ("Since the consumer is the same type of consumer used in the");
  2690.       PUT_LINE ("other producer/consumer tests these results can be compared");
  2691.       PUT_LINE ("to the simple producer/consumer test.");
  2692.       NEW_LINE;
  2693.                                                                        
  2694.       declare
  2695.         package Conditional_Pkg is new Benchmark
  2696.                 (Overhead => Not_Accepted,
  2697.                  Item_Of_Interest => Accepted);
  2698.       begin
  2699.         Conditional_Pkg.Timer;
  2700.         Enabled_Task.Take_Item (Terminate_Item);  -- kill off the tasks
  2701.         Disabled_Task.Enable_Takes;
  2702.         Disabled_Task.Take_Item (Terminate_Item);  
  2703.     Ada Benchmark Suite Version 1.0                              Page A-47
  2704.  
  2705.  
  2706.       end;
  2707.  
  2708.     exception
  2709.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  2710.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  2711.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  2712.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  2713.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  2714.       when others           => PUT_LINE ("*** test aborted due to exception");
  2715.     end Time_Conditional_Entry;
  2716.     pragma PAGE;
  2717.  
  2718.     procedure Time_Timed_Entry is
  2719.       Enabled_Task   : Called_Consumer_Type_1;
  2720.       Disabled_Task   : Called_Consumer_Type_2;
  2721.       Not_Accepted_Err,
  2722.       Accepted_Err : INTEGER := 0;
  2723.  
  2724.       procedure Not_Accepted (Iterations : in NATURAL) is
  2725.       begin
  2726.         for J in 1..Iterations loop
  2727.           select
  2728.             Disabled_Task.Take_Item (Continue_Item);
  2729.             Not_Accepted_Err := Not_Accepted_Err + 1;
  2730.           or
  2731.             delay 0.0;
  2732.           end select;
  2733.         end loop;
  2734.       end Not_Accepted;
  2735.  
  2736.       procedure Accepted (Iterations : in NATURAL) is
  2737.       begin
  2738.         for J in 1..Iterations loop
  2739.           select
  2740.             Enabled_Task.Take_Item (Continue_Item);
  2741.           or
  2742.             delay 0.0;
  2743.             Accepted_Err := Accepted_Err + 1;
  2744.           end select;
  2745.         end loop;
  2746.       end Accepted;
  2747.  
  2748.     begin
  2749.       NEW_LINE (2);
  2750.       PUT_LINE ("TIMED ENTRY");
  2751.       PUT_LINE ("In this test the main task calls a consumer task with a");
  2752.       PUT_LINE ("timed entry call with a time limit of 0.0.  The test tries");
  2753.       PUT_LINE ("calls that are not accepted then tries calls that are accepted.");
  2754.       PUT_LINE ("Since the consumer is the same type of consumer used in the");
  2755.       PUT_LINE ("other producer/consumer tests these results can be compared");
  2756.       PUT_LINE ("to the simple producer/consumer test.");
  2757.       NEW_LINE;
  2758.  
  2759.     Ada Benchmark Suite Version 1.0                              Page A-48
  2760.  
  2761.  
  2762.       declare
  2763.         package Timed_Entry_Pkg is new Benchmark
  2764.                 (Overhead => Not_Accepted,
  2765.                  Item_Of_Interest => Accepted);
  2766.       begin
  2767.         Timed_Entry_Pkg.Timer;
  2768.         Enabled_Task.Take_Item (Terminate_Item);  -- kill off the tasks
  2769.         Disabled_Task.Enable_Takes;
  2770.         Disabled_Task.Take_Item (Terminate_Item);
  2771.       end;
  2772.  
  2773.     exception
  2774.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  2775.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  2776.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  2777.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  2778.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  2779.       when others           => PUT_LINE ("*** test aborted due to exception");
  2780.     end Time_Timed_Entry;
  2781.     pragma PAGE;
  2782.  
  2783.     procedure Time_Family is
  2784.       
  2785.       type Family is range 1 .. 10;  -- size of entry family
  2786.       Family_Member : Family := 3;   -- this is the one we will use
  2787.  
  2788.       task Some_Task is
  2789.             -- consumer is to take items until 
  2790.             -- a value of Terminat_Item is accepted.
  2791.         entry Take_Item (Family)(Item : in INTEGER);
  2792.       end Some_Task;
  2793.  
  2794.  
  2795.       task body Some_Task is
  2796.         Item : INTEGER;
  2797.       begin
  2798.         loop
  2799.           accept Take_Item (Family_Member) (Item : in INTEGER) do
  2800.             Some_Task.Item := Item;
  2801.           end Take_Item;
  2802.  
  2803.           exit when Item = Terminate_Item;
  2804.  
  2805.         end loop;
  2806.       end Some_Task;
  2807.  
  2808.  
  2809.     begin
  2810.       NEW_LINE (2);
  2811.       PUT_LINE ("FAMILY OF ENTRIES");
  2812.       PUT_LINE ("This test is similar to the simple producer/consumer (SIMPLE PC)");
  2813.       PUT_LINE ("in that the main task produces integer values that are consumed");
  2814.       PUT_LINE ("by a consumer task.  The difference is that the consumer task");
  2815.     Ada Benchmark Suite Version 1.0                              Page A-49
  2816.  
  2817.  
  2818.       PUT_LINE ("uses a family of entries instead of a single entry.");
  2819.       NEW_LINE;
  2820.  
  2821.       declare
  2822.         procedure Send_Item (Iterations : in NATURAL) is
  2823.         begin
  2824.           for J in 1..Iterations Loop
  2825.             Some_Task.Take_Item (Family_Member) (Continue_Item);
  2826.           end loop;
  2827.         end Send_Item;
  2828.  
  2829.         package Family_Pkg is new Benchmark
  2830.                 (Item_Of_Interest => Send_Item);
  2831.  
  2832.       begin
  2833.         Family_Pkg.Timer;
  2834.         Some_Task.Take_Item (Family_Member) (Terminate_Item);
  2835.       end;
  2836.  
  2837.     exception
  2838.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  2839.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  2840.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  2841.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  2842.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  2843.       when others           => PUT_LINE ("*** test aborted due to exception");
  2844.     end Time_Family;
  2845.     pragma PAGE;
  2846.  
  2847.     procedure Time_Simple_Sync is
  2848.       task Sync is
  2849.         entry Pass;
  2850.       end Sync;
  2851.  
  2852.       task body Sync is
  2853.       begin
  2854.         loop
  2855.           accept Pass;
  2856.         end loop;
  2857.       end Sync;
  2858.  
  2859.     begin
  2860.       NEW_LINE (2);
  2861.       PUT_LINE ("SIMPLE SYNCHRONIZATION");
  2862.       PUT_LINE ("This test times the use of a simple synchronization task entry.");
  2863.       PUT_LINE ("In this type of task interaction no parameters are passed to the");
  2864.       PUT_LINE ("task entry and there is no body for the accept. The called task");
  2865.       PUT_LINE ("loops on an unconditional accept.");
  2866.       NEW_LINE;
  2867.  
  2868.       declare
  2869.         procedure Call_Sync (Iterations : in NATURAL) is
  2870.         begin
  2871.     Ada Benchmark Suite Version 1.0                              Page A-50
  2872.  
  2873.  
  2874.           for J in 1..Iterations loop
  2875.             Sync.Pass;
  2876.           end loop;
  2877.         end Call_Sync;
  2878.  
  2879.         package Simple_Sync_Pkg is new Benchmark
  2880.                 (Item_Of_Interest => Call_Sync);
  2881.  
  2882.       begin
  2883.         Simple_Sync_Pkg.Timer;
  2884.         abort Sync;   -- kill off the task
  2885.       end;
  2886.  
  2887.     exception
  2888.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  2889.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  2890.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  2891.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  2892.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  2893.       when others           => PUT_LINE ("*** test aborted due to exception");
  2894.     end Time_Simple_Sync;
  2895.     pragma PAGE;
  2896.  
  2897.     procedure Time_Sync_With_Term is
  2898.       task Sync is
  2899.         entry Pass;
  2900.       end Sync;
  2901.  
  2902.       task body Sync is
  2903.       begin
  2904.         loop
  2905.           select
  2906.             accept Pass;
  2907.           or
  2908.             terminate;
  2909.           end select;
  2910.         end loop;
  2911.       end Sync;
  2912.  
  2913.     begin
  2914.       NEW_LINE (2);
  2915.       PUT_LINE ("SYNCHRONIZATION WITH TERMINATION");
  2916.       PUT_LINE ("This test times the use of a simple synchronization task entry.");
  2917.       PUT_LINE ("In this type of task interaction no parameters are passed to the");
  2918.       PUT_LINE ("task entry and there is no body for the accept. The called task");
  2919.       PUT_LINE ("loops on an select statement containing an accept and a");
  2920.       PUT_LINE ("terminate alternative.");
  2921.       NEW_LINE;
  2922.  
  2923.       declare
  2924.         procedure Call_Sync (Iterations : in NATURAL) is
  2925.         begin
  2926.           for J in 1..Iterations loop
  2927.     Ada Benchmark Suite Version 1.0                              Page A-51
  2928.  
  2929.  
  2930.             Sync.Pass;
  2931.           end loop;
  2932.         end Call_Sync;
  2933.  
  2934.         package Sync_Term_Pkg is new Benchmark
  2935.                 (Item_Of_Interest => Call_Sync);
  2936.  
  2937.       begin
  2938.         Sync_Term_Pkg.Timer;
  2939.       end;
  2940.  
  2941.     exception
  2942.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  2943.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  2944.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  2945.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  2946.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  2947.       when others           => PUT_LINE ("*** test aborted due to exception");
  2948.     end Time_Sync_With_Term;
  2949.     pragma PAGE;
  2950.  
  2951.     procedure Time_Term_Option is
  2952.       Open_Terminate : BOOLEAN := FALSE;
  2953.  
  2954.       task Sync is
  2955.         entry Pass;
  2956.       end Sync;
  2957.  
  2958.       task body Sync is
  2959.       begin
  2960.         loop
  2961.           select
  2962.             accept Pass;
  2963.           or
  2964.             when Open_Terminate =>
  2965.             terminate;
  2966.           end select;
  2967.         end loop;
  2968.       end Sync;
  2969.  
  2970.     begin
  2971.       NEW_LINE (2);
  2972.       PUT_LINE ("TERMINATE OPTION");
  2973.       PUT_LINE ("This test times the use of a simple synchronization task entry");
  2974.       PUT_LINE ("both without and with a terminate option.  The overhead test");
  2975.       PUT_LINE ("is for the time without the terminate option.");
  2976.       PUT_LINE ("In this type of task interaction no parameters are passed to the");
  2977.       PUT_LINE ("task entry and there is no body for the accept. The called task");
  2978.       PUT_LINE ("loops on an select statement containing an accept and a");
  2979.       PUT_LINE ("conditional terminate alternative.");
  2980.       NEW_LINE;
  2981.  
  2982.       declare
  2983.     Ada Benchmark Suite Version 1.0                              Page A-52
  2984.  
  2985.  
  2986.         procedure Closed_Terminate (Iterations : in NATURAL) is
  2987.         begin
  2988.           for J in 1..Iterations loop
  2989.             Sync.Pass;
  2990.           end loop;
  2991.         end Closed_Terminate;
  2992.  
  2993.         procedure Opened_Terminate (Iterations : in NATURAL) is
  2994.         begin         
  2995.           Open_Terminate := TRUE;
  2996.           for J in 1..Iterations loop
  2997.             Sync.Pass;
  2998.           end loop;
  2999.         end Opened_Terminate;
  3000.  
  3001.         package Term_Option_Pkg is new Benchmark
  3002.                 (Overhead => Closed_Terminate,
  3003.                  Item_Of_Interest => Opened_Terminate);
  3004.  
  3005.       begin
  3006.         Term_Option_Pkg.Timer;
  3007.       end;
  3008.  
  3009.     exception
  3010.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  3011.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  3012.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  3013.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  3014.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  3015.       when others           => PUT_LINE ("*** test aborted due to exception");
  3016.     end Time_Term_Option;
  3017.     pragma PAGE;
  3018.  
  3019.     begin
  3020.       PUT_LINE ("               Task Interaction");
  3021.       NEW_LINE;
  3022.       PUT_LINE ("This test times various task interactions in order to determine");
  3023.       PUT_LINE ("their relative cost. These tests are related to the task");
  3024.       PUT_LINE ("communication tests and in many cases the output should be");
  3025.       PUT_LINE ("compared to those tests (see each test for details).");
  3026.  
  3027.       Time_Procedure_Calls;
  3028.       Time_Conditional_Entry;
  3029.       Time_Timed_Entry;
  3030.       Time_Family;
  3031.       Time_Simple_Sync;
  3032.       Time_Sync_With_Term;
  3033.       Time_Term_Option;
  3034.  
  3035.     exception
  3036.       when CONSTRAINT_ERROR => PUT_LINE ("*** test aborted due to constraint err");
  3037.       when NUMERIC_ERROR    => PUT_LINE ("*** test aborted due to numeric error");
  3038.       when PROGRAM_ERROR    => PUT_LINE ("*** test aborted due to program error");
  3039.     Ada Benchmark Suite Version 1.0                              Page A-53
  3040.  
  3041.  
  3042.       when STORAGE_ERROR    => PUT_LINE ("*** test aborted due to storage error");
  3043.       when TASKING_ERROR    => PUT_LINE ("*** test aborted due to tasking error");
  3044.       when others           => PUT_LINE ("*** test aborted due to exception");
  3045.  
  3046.     end Do_Test;
  3047.  
  3048.     end Part5;
  3049.  
  3050.     Ada Benchmark Suite Version 1.0                              Page A-54
  3051.  
  3052.  
  3053.     A.19  DRIVER.ADA
  3054.  
  3055.     The following is a listing of the driver for the Tasking benchmark:
  3056.  
  3057.  
  3058.  
  3059.     ---------------- tasking benchmark main driver -----------------------
  3060.  
  3061.     ------------------ note that SYSTEM is included so that system dependent
  3062.     ------------------ characteristics can be displayed.
  3063.     with TEXT_IO, SYSTEM, CALENDAR;
  3064.     use  TEXT_IO;
  3065.  
  3066.     ------------------ all the tests are in packages PartN procedure Do_Test
  3067.     ------------------ where N ranges from 1 to the number of test sections
  3068.     with Part1, Part2, Part3, Part4, Part5;
  3069.  
  3070.     procedure Driver is
  3071.       Version : constant STRING := "August 1, 1986"; -- last modification date
  3072.  
  3073.  
  3074.       Quiet : BOOLEAN;  -- true implies no further prompting on each test
  3075.                         -- and that each test is to be run.
  3076.  
  3077.       Results : FILE_TYPE;     -- file where test results are written.
  3078.                                -- Do not use this file directly.  Instead, use
  3079.                                -- standard output for user messages and 
  3080.                                -- current output for test results.
  3081.  
  3082.     procedure Print_Header_Info is
  3083.     use SYSTEM;
  3084.     begin
  3085.       PUT_LINE ("                      Tasking Benchmark");
  3086.       NEW_LINE;
  3087.       PUT_LINE ("Benchmark Version of " & Version);
  3088.       PUT_LINE ("System is " & SYSTEM.NAME'IMAGE (SYSTEM_NAME));
  3089.  
  3090.       declare
  3091.         use CALENDAR;
  3092.         Yr : YEAR_NUMBER;
  3093.         Mo : MONTH_NUMBER;
  3094.         Da : DAY_NUMBER;
  3095.         Se : DAY_DURATION;
  3096.         Hr  : INTEGER range 0 .. 23;
  3097.         Min : INTEGER range 0 .. 59;
  3098.         Sec : INTEGER range 0 .. 86_400;  -- seconds in a day
  3099.       begin
  3100.         SPLIT (CLOCK, Yr, Mo, Da, Se);
  3101.         Sec := INTEGER (Se);
  3102.         Hr := Sec / 3600;
  3103.         Min := (Sec - Hr * 3600) / 60;
  3104.         PUT      ("Benchmark run on ");
  3105.         case Mo is
  3106.     Ada Benchmark Suite Version 1.0                              Page A-55
  3107.  
  3108.  
  3109.           when  1 => PUT ("January");
  3110.           when  2 => PUT ("February");
  3111.           when  3 => PUT ("March");
  3112.           when  4 => PUT ("April");
  3113.           when  5 => PUT ("May");
  3114.           when  6 => PUT ("June");
  3115.           when  7 => PUT ("July");
  3116.           when  8 => PUT ("August");
  3117.           when  9 => PUT ("September");
  3118.           when 10 => PUT ("October");
  3119.           when 11 => PUT ("November");
  3120.           when 12 => PUT ("December");
  3121.         end case;
  3122.         PUT_LINE (INTEGER'IMAGE (Da) & "," & INTEGER'IMAGE (Yr) & "   " & 
  3123.                   INTEGER'IMAGE (Hr * 100 + Min));
  3124.       end;
  3125.  
  3126.       declare
  3127.         package Float_Text_IO is new FLOAT_IO (FLOAT);
  3128.         X : FLOAT;
  3129.       begin
  3130.         PUT ("Basic Clock Period (SYSTEM.TICK) is ");
  3131.         X := FLOAT (TICK);
  3132.         Float_Text_IO.DEFAULT_EXP := 0;  -- dont want scientific notation
  3133.         Float_Text_IO.PUT (X);
  3134.         PUT_LINE (" seconds.");
  3135.       end;
  3136.  
  3137.       PUT_LINE ("INTEGER is represented with" & INTEGER'IMAGE (INTEGER'SIZE) &
  3138.                 " bits.");
  3139.       
  3140.       declare
  3141.         task type T;
  3142.         task body T is begin null; end T;
  3143.       begin
  3144.         PUT_LINE ("An empty task is allocated" & INTEGER'IMAGE (T'STORAGE_SIZE) &
  3145.                   " storage units.");
  3146.       end;
  3147.     end Print_Header_Info;
  3148.  
  3149.  
  3150.     function Ask (Question : STRING) return BOOLEAN is
  3151.       Ch : CHARACTER;
  3152.     begin
  3153.       PUT (STANDARD_OUTPUT, Question & " (Y/N)? ");
  3154.       loop
  3155.         GET (Ch);
  3156.         if (Ch = 'Y') or (Ch = 'y') then
  3157.           return TRUE;
  3158.         elsif (Ch = 'N') or (Ch = 'n') then
  3159.           return FALSE;
  3160.         end if;
  3161.       end loop;
  3162.     Ada Benchmark Suite Version 1.0                              Page A-56
  3163.  
  3164.  
  3165.     end Ask;
  3166.  
  3167.  
  3168.     procedure Open_Files is
  3169.       -- this procedure opens the output file for the results and makes
  3170.       -- this file the default output file.
  3171.  
  3172.       Name : STRING (1 .. 80);
  3173.       Len  : INTEGER range 0 .. Name'LAST;
  3174.     begin
  3175.       Try_To_Open:
  3176.       loop
  3177.         PUT ("File name for results (<cr> for console) ");
  3178.         GET_LINE (Name, Len);
  3179.         exit Try_To_Open when Len = 0;
  3180.           
  3181.         begin
  3182.           CREATE (Results, NAME => Name (1 .. Len));
  3183.           SET_OUTPUT (Results);
  3184.           exit Try_To_Open;
  3185.         exception
  3186.           when NAME_ERROR | USE_ERROR => PUT_LINE ("Cannot create file");
  3187.         end;
  3188.       end loop Try_To_Open;
  3189.     end Open_Files;
  3190.  
  3191.     begin  -- Driver
  3192.       PUT_LINE ("Tasking Benchmark");
  3193.       Open_Files;
  3194.       Quiet := Ask ("Do you wish to run all the tests");
  3195.  
  3196.       Print_Header_Info;
  3197.  
  3198.       if Quiet or else Ask ("Run " & Part1.Title & " timings") then
  3199.         NEW_PAGE;
  3200.         Part1.Do_Test;
  3201.       end if;
  3202.  
  3203.       if Quiet or else Ask ("Run " & Part2.Title & " timings") then
  3204.         NEW_PAGE;
  3205.         Part2.Do_Test;
  3206.       end if;
  3207.  
  3208.       if Quiet or else Ask ("Run " & Part3.Title & " timings") then
  3209.         NEW_PAGE;
  3210.         Part3.Do_Test;
  3211.       end if;
  3212.  
  3213.       if Quiet or else Ask ("Run " & Part4.Title & " timings") then
  3214.         NEW_PAGE;
  3215.         Part4.Do_Test;
  3216.       end if;
  3217.  
  3218.     Ada Benchmark Suite Version 1.0                              Page A-57
  3219.  
  3220.  
  3221.       if Quiet or else Ask ("Run " & Part5.Title & " timings") then
  3222.         NEW_PAGE;
  3223.         Part5.Do_Test;
  3224.       end if;
  3225.  
  3226.  
  3227.       -- other tests go here
  3228.  
  3229.  
  3230.       if LINE > 50 then
  3231.         NEW_PAGE;
  3232.       else
  3233.         NEW_LINE (10);
  3234.       end if;
  3235.  
  3236.       PUT_LINE (STANDARD_OUTPUT, "Test Complete");
  3237.     end Driver;
  3238.