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