198 lines · 4.3 KB · Forth
RawDownload
\ @(#) bench.fth 97/12/10 1.1\ Benchmark Forth\ by Phil Burk\ 11/17/95\\ pForthV9 on Indy, compiled with gcc\  bench1  took 15 seconds\  bench2  took 16 seconds\  bench3  took 17 seconds\  bench4  took 17 seconds\  bench5  took 19 seconds\  sieve   took  4 seconds\\ Darren Gibbs reports that on an SGI Octane loaded with multiple users:\  bench1  took 2.8sec\  bench2  took 2.7\  bench3  took 2.9\  bench4  took 2.1\  bench 5 took 2.5\  seive   took .6\\ HForth on Mac Quadra 800, 68040\  bench1  took 1.73 seconds\  bench2  took 6.48 seconds\  bench3  took 2.65 seconds\  bench4  took 2.50 seconds\  bench5  took 1.91 seconds\  sieve   took 0.45 seconds\\ pForthV9 on Mac Quadra 800\  bench1  took 40 seconds\  bench2  took 43 seconds\  bench3  took 43 seconds\  bench4  took 44 seconds\  bench5  took 42 seconds\  sieve   took 20 seconds\\ pForthV9 on PB5300, 100 MHz PPC 603 based Mac Powerbook\  bench1  took 8.6 seconds\  bench2  took 9.0 seconds\  bench3  took 9.7 seconds\  bench4  took 8.8 seconds\  bench5  took 10.3 seconds\  sieve   took 2.3 seconds\\ HForth on PB5300\  bench1  took 1.1 seconds\  bench2  took 3.6 seconds\  bench3  took 1.7 seconds\  bench4  took 1.2 seconds\  bench5  took 1.3 seconds\  sieve   took 0.2 seconds anew task-bench.fth decimal \ benchmark primitivescreate #do 2000000   , : t1           #do @ 0      do                     loop ;: t2  23 45    #do @ 0      do  swap               loop   2drop ;: t3  23       #do @ 0      do  dup drop           loop drop ;: t4  23 45    #do @ 0      do  over drop          loop 2drop ;: t5           #do @ 0      do  23 45 + drop       loop ;: t6  23       #do @ 0      do  >r r>              loop drop ;: t7  23 45 67 #do @ 0      do  rot                loop 2drop drop ;: t8           #do @ 0      do  23 2* drop         loop  ;: t9           #do @ 10 / 0 do  23 5 /mod 2drop    loop ;: t10     #do  #do @ 0      do  dup @ drop         loop drop ; : foo ( noop ) ;: t11          #do @ 0      do  foo                loop ; \ more complex benchmarks ----------------------- \ BENCH1 - sum data ---------------------------------------create data1 23 , 45 , 67 , 89 , 111 , 222 , 333 , 444 ,: sum.cells ( addr num -- sum )    0 swap \ sum    0 DO        over \ get address        i cells + @ +    LOOP    swap drop; : bench1 ( -- )    200000 0    DO        data1 8 sum.cells drop    LOOP; \ BENCH2 - recursive factorial --------------------------: factorial ( n -- n! )    dup 1 >    IF        dup 1- recurse *    ELSE        drop 1    THEN; : bench2 ( -- )    200000 0    DO        10 factorial drop    LOOP; \ BENCH3 - DEFER ----------------------------------defer calc.answer: answer ( n -- m )    dup +    $ a5a5 xor    1000 max;' answer is calc.answer: bench3    1500000 0    DO        i calc.answer drop    LOOP; \ BENCH4 - locals ---------------------------------: use.locals { x1 x2 | aa bb -- result }    x1 2* -> aa    x2 2/ -> bb    x1 aa *    x2 bb * +; : bench4    400000 0    DO        234 567 use.locals drop    LOOP; \ BENCH5 - string compare -------------------------------: match.strings { $s1 $s2 | adr1 len1 adr2 len2 -- flag }    $s1 count -> len1 -> adr1    $s2 count -> len2 -> adr2    len1 len2 -    IF        FALSE    ELSE        TRUE        len1 0        DO            adr1 i + c@            adr2 i + c@ -            IF                drop FALSE                leave            THEN        LOOP    THEN; : bench5 ( -- )    60000 0    DO        " This is a string. X foo"        " This is a string. Y foo" match.strings drop    LOOP; \ SIEVE OF ERATOSTHENES from BYTE magazine ----------------------- DECIMAL 8190 CONSTANT TSIZE VARIABLE FLAGS TSIZE ALLOT : <SIEVE>  ( --- #primes )  FLAGS TSIZE 1 FILL 0  TSIZE 0 DO   ( n )  I FLAGS + C@      IF    I  DUP +  3 +   DUP I +  (  I2*+3 I3*+3 )           BEGIN  DUP TSIZE <  ( same flag )           WHILE  0 OVER FLAGS + C! (  i' i'' )   OVER +           REPEAT 2DROP  1+      THEN LOOP       ; : SIEVE  ." 10 iterations " CR  0   10 0  DO     <SIEVE> swap drop  LOOP   . ." primes " CR ; : SIEVE50  ." 50 iterations " CR  0   50 0  DO     <SIEVE> swap drop  LOOP   . ." primes " CR ; \ 10 iterations\ 21.5 sec  Amiga Multi-Forth  Indirect Threaded\ 8.82 sec  Amiga 1000 running JForth\ ~5 sec  SGI Indy running pForthV9