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

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