git.gag.com Git - debian/pforth/blob - fth/bench.fth

   1 \ @(#) bench.fth 97/12/10 1.1
   2 \ Benchmark Forth
   3 \ by Phil Burk
   4 \ 11/17/95
   5 \
   6 \ pForthV9 on Indy, compiled with gcc
   7 \  bench1  took 15 seconds
   8 \  bench2  took 16 seconds
   9 \  bench3  took 17 seconds
  10 \  bench4  took 17 seconds
  11 \  bench5  took 19 seconds
  12 \  sieve   took  4 seconds
  13 \
  14 \ Darren Gibbs reports that on an SGI Octane loaded with multiple users:
  15 \  bench1  took 2.8sec
  16 \  bench2  took 2.7
  17 \  bench3  took 2.9
  18 \  bench4  took 2.1
  19 \  bench 5 took 2.5
  20 \  seive   took .6
  21 \
  22 \ HForth on Mac Quadra 800, 68040
  23 \  bench1  took 1.73 seconds
  24 \  bench2  took 6.48 seconds
  25 \  bench3  took 2.65 seconds
  26 \  bench4  took 2.50 seconds
  27 \  bench5  took 1.91 seconds
  28 \  sieve   took 0.45 seconds
  29 \
  30 \ pForthV9 on Mac Quadra 800
  31 \  bench1  took 40 seconds
  32 \  bench2  took 43 seconds
  33 \  bench3  took 43 seconds
  34 \  bench4  took 44 seconds
  35 \  bench5  took 42 seconds
  36 \  sieve   took 20 seconds
  37 \
  38 \ pForthV9 on PB5300, 100 MHz PPC 603 based Mac Powerbook
  39 \  bench1  took 8.6 seconds
  40 \  bench2  took 9.0 seconds
  41 \  bench3  took 9.7 seconds
  42 \  bench4  took 8.8 seconds
  43 \  bench5  took 10.3 seconds
  44 \  sieve   took 2.3 seconds
  45 \
  46 \ HForth on PB5300
  47 \  bench1  took 1.1 seconds
  48 \  bench2  took 3.6 seconds
  49 \  bench3  took 1.7 seconds
  50 \  bench4  took 1.2 seconds
  51 \  bench5  took 1.3 seconds
  52 \  sieve   took 0.2 seconds
  53
  54 anew task-bench.fth
  55
  56 decimal
  57
  58 \ benchmark primitives
  59 create #do 2000000   ,
  60
  61 : t1           #do @ 0      do                     loop ;
  62 : t2  23 45    #do @ 0      do  swap               loop   2drop ;
  63 : t3  23       #do @ 0      do  dup drop           loop drop ;
  64 : t4  23 45    #do @ 0      do  over drop          loop 2drop ;
  65 : t5           #do @ 0      do  23 45 + drop       loop ;
  66 : t6  23       #do @ 0      do  >r r>              loop drop ;
  67 : t7  23 45 67 #do @ 0      do  rot                loop 2drop drop ;
  68 : t8           #do @ 0      do  23 2* drop         loop  ;
  69 : t9           #do @ 10 / 0 do  23 5 /mod 2drop    loop ;
  70 : t10     #do  #do @ 0      do  dup @ drop         loop drop ;
  71
  72 : foo ( noop ) ;
  73 : t11          #do @ 0      do  foo                loop ;
  74
  75 \ more complex benchmarks -----------------------
  76
  77 \ BENCH1 - sum data ---------------------------------------
  78 create data1 23 , 45 , 67 , 89 , 111 , 222 , 333 , 444 ,
  79 : sum.cells ( addr num -- sum )
  80     0 swap \ sum
  81     0 DO
  82         over \ get address
  83         i cells + @ +
  84     LOOP
  85     swap drop
  86 ;
  87
  88 : bench1 ( -- )
  89     200000 0
  90     DO
  91         data1 8 sum.cells drop
  92     LOOP
  93 ;
  94
  95 \ BENCH2 - recursive factorial --------------------------
  96 : factorial ( n -- n! )
  97     dup 1 >
  98     IF
  99         dup 1- recurse *
 100     ELSE
 101         drop 1
 102     THEN
 103 ;
 104
 105 : bench2 ( -- )
 106     200000 0
 107     DO
 108         10 factorial drop
 109     LOOP
 110 ;
 111
 112 \ BENCH3 - DEFER ----------------------------------
 113 defer calc.answer
 114 : answer ( n -- m )
 115     dup +
 116     $ a5a5 xor
 117     1000 max
 118 ;
 119 ' answer is calc.answer
 120 : bench3
 121     1500000 0
 122     DO
 123         i calc.answer drop
 124     LOOP
 125 ;
 126
 127 \ BENCH4 - locals ---------------------------------
 128 : use.locals { x1 x2 | aa bb -- result }
 129     x1 2* -> aa
 130     x2 2/ -> bb
 131     x1 aa *
 132     x2 bb * +
 133 ;
 134
 135 : bench4
 136     400000 0
 137     DO
 138         234 567 use.locals drop
 139     LOOP
 140 ;
 141
 142 \ BENCH5 - string compare -------------------------------
 143 : match.strings { $s1 $s2 | adr1 len1 adr2 len2 -- flag }
 144     $s1 count -> len1 -> adr1
 145     $s2 count -> len2 -> adr2
 146     len1 len2 -
 147     IF
 148         FALSE
 149     ELSE
 150         TRUE
 151         len1 0
 152         DO
 153             adr1 i + c@
 154             adr2 i + c@ -
 155             IF
 156                 drop FALSE
 157                 leave
 158             THEN
 159         LOOP
 160     THEN
 161 ;
 162
 163 : bench5 ( -- )
 164     60000 0
 165     DO
 166         " This is a string. X foo"
 167         " This is a string. Y foo" match.strings drop
 168     LOOP
 169 ;
 170
 171 \ SIEVE OF ERATOSTHENES from BYTE magazine -----------------------
 172
 173 DECIMAL 8190 CONSTANT TSIZE
 174
 175 VARIABLE FLAGS TSIZE ALLOT
 176
 177 : <SIEVE>  ( --- #primes )  FLAGS TSIZE 1 FILL
 178  0  TSIZE 0
 179  DO   ( n )  I FLAGS + C@
 180       IF    I  DUP +  3 +   DUP I +  (  I2*+3 I3*+3 )
 181            BEGIN  DUP TSIZE <  ( same flag )
 182            WHILE  0 OVER FLAGS + C! (  i' i'' )   OVER +
 183            REPEAT 2DROP  1+
 184       THEN
 185  LOOP       ;
 186
 187 : SIEVE  ." 10 iterations " CR  0   10 0
 188   DO     <SIEVE> swap drop
 189   LOOP   . ." primes " CR ;
 190
 191 : SIEVE50  ." 50 iterations " CR  0   50 0
 192   DO     <SIEVE> swap drop
 193   LOOP   . ." primes " CR ;
 194
 195 \ 10 iterations
 196 \ 21.5 sec  Amiga Multi-Forth  Indirect Threaded
 197 \ 8.82 sec  Amiga 1000 running JForth
 198 \ ~5 sec  SGI Indy running pForthV9