regina/demo/rexxcps.rexx

   1 /* ReXX */
   2   /* Take a measure of REXX clauses-per-second (CPS)                 */
   3   /* Mike Cowlishaw (mfc@ibm.com).  Multi-platform.                  */
   4   /* 1.0 17 Jan 89 Original version                                  */
   5   /* 2.0  3 Jun 89 Remove attempt to simulate commands               */
   6   /* 2.1  7 Oct 89 Remove use of not symbols, and correct commentary */
   7   /* 2.2 31 Mar 00 Allow measures/iterations/tracevar to be passed on*/
   8   /*               command line. mhes                                */
   9   rexxcps=2.2    /* REXXCPS version; quotable only if code unchanged */
  10
  11   /* This measure of REXX execution speed is based on an analysis of */
  12   /* the dynamic mix of clauses found in a (subjectively chosen)     */
  13   /* collection of REXX programs (including commands, macros, and    */
  14   /* personal programs).  Approximately 2,500,000 lines of trace     */
  15   /* output were analysed, and the program below recreates the       */
  16   /* dynamic mix of constructs found in that analysis.               */
  17   /* In view of the dramatic differences between systems in their    */
  18   /* efficiency of issuing commands, the timed loop does not issue   */
  19   /* commands (an 'RC=expression; PARSE' sequence is used instead).  */
  20   /* This program therefore measures the performance of a REXX       */
  21   /* implementation, exclusive of command execution overhead.        */
  22   /* Elapsed (user-perceived) time is used, rather than any form of  */
  23   /* virtual time.                                                   */
  24
  25   Parse Arg averaging count tracevar
  26   if averaging = '' Then averaging = 10  /* Averaging-over count */
  27   if count = '' Then count = 30  /* Repetition count */
  28   if tracevar = '' then tracevar = 'Off' /* Trace setting (for development use) */
  29   signal on novalue
  30   parse source  source  1 system .
  31   parse version version
  32
  33
  34   say '----- REXXCPS' rexxcps '-- Measuring REXX clauses/second -----'
  35   say ' REXX version is:' version
  36   say '       System is:' system
  37   say '       Averaging:' averaging 'measures of' count 'iterations'
  38
  39   /* ----- Calibrate for the empty do-loop (average of 5) ----- */
  40   empty=0
  41   do i=1 to averaging
  42     call time 'R'
  43     do count; end
  44     empty=time('R')+empty
  45     end
  46   empty=empty/averaging
  47
  48   noterm=(system='CMS'); if pos('O',tracevar)=1 then noterm=0
  49   if noterm then do
  50      say 'Calibration (empty DO):' empty 'secs (average of' averaging')'
  51      say 'Spooling trace NOTERM'
  52      'CP SPOOL CON * START NOTERM'; 'CP CLOSE CON PUR'
  53      end
  54
  55   /* Now the true timer loop .. average timing again */
  56   full=0
  57   do i=1 to averaging
  58     trace value tracevar
  59     call time 'R'
  60     do count;
  61       /* -----  This is first of the 1000 clauses ----- */
  62       flag=0; p0='b'
  63       do loop=1 to 14
  64         /* This is the "block" comment in loop */
  65         key1='Key Bee'
  66         acompound.key1.loop=substr(1234"5678",6,2)
  67         if flag=acompound.key1.loop then say 'Failed1'
  68         do j=1.1 to 2.2 by 1.1   /* executed 28 times */
  69           if j>acompound.key1.loop then say 'Failed2'
  70           if 17<length(j)-1        then say 'Failed3'
  71           if j='foobar'            then say 'Failed4'
  72           if substr(1234,1,1)=9    then say 'Failed5'
  73           if word(key1,1)='?'      then say 'Failed6'
  74           if j<5 then do   /* This path taken */
  75             acompound.key1.loop=acompound.key1.loop+1
  76             if j=2 then leave
  77             end
  78           iterate
  79           end /* j */
  80         avar.=1.0''loop
  81         select
  82           when flag='string' then say 'FailedS1'
  83           when avar.flag.2=0 then say 'FailedS2'
  84           when flag=5+99.7   then say 'FailedS3'
  85           when flag          then avar.1.2=avar.1.2*1.1
  86           when flag==0       then flag=0
  87           end
  88         if 1 then flag=1
  89         select
  90           when flag=='ring'  then say 'FailedT1'
  91           when avar.flag.3=0 then say 'FailedT2'
  92           when flag          then avar.1.2=avar.1.2*1.1
  93           when flag==0       then flag=1
  94           end
  95         parse value 'Foo Bar' with v1 +5 v2 .
  96         trace value trace(); address value address()
  97         call subroutine 'with' 2 'args', '(This is the second)'1''1
  98         rc='This is an awfully boring program'; parse var rc p1 (p0) p5
  99         rc='is an awfully boring program This'; parse var rc p2 (p0) p6
 100         rc='an awfully boring program This is'; parse var rc p3 (p0) p7
 101         rc='awfully boring program This is an'; parse var rc p4 (p0) p8
 102         end loop
 103       /* -----  This is last of the 1000 clauses ----- */
 104       end
 105     full=time('R')+full
 106     trace off
 107     end
 108   full=full/averaging
 109   if noterm then do
 110      'CP CLOSE CON'; 'CP SPOOL CON * START TERM'
 111      say 'Spooling now back on TERM'
 112      end
 113
 114   /* Now display the statistics */
 115   looptime=(full-empty)/count
 116
 117   /* Developer's statistics: */
 118   if left(tracevar,1)='O' then nop; else do
 119     say
 120     say 'Total (full DO):' full-empty 'secs (average of' averaging ,
 121       'measures of' count 'iterations)'
 122     say 'Time for one iteration (1000 clauses) was:' looptime 'seconds'
 123     end
 124   /* And finally, the Result... */
 125
 126   if looptime = 0 Then do
 127      say '     The granularity of the system clock appears to be too coarse to'
 128      say '     obtain an effective result.  Re-run this progam and increase the'
 129      say '     number of iterations or the repeat count.'
 130      end
 131   else do
 132      say
 133      say'     Performance:' format(1000/looptime,,0) 'REXX clauses per second'
 134      say
 135      end
 136
 137   exit
 138
 139
 140   /* Target routine for the timed CALL - called 14 times */
 141   subroutine:
 142     parse upper arg a1 a2 a3 ., a4
 143     parse var a3 b1 b2 b3 .
 144     do 1; rc=a1 a2 a3; parse var rc c1 c2 c3; end
 145     return
 146
 147   novalue: if noterm then 'CP SP CON STOP TERM'
 148     say 'novalue triggered'
 149   /* -- end of program -- */