\ @(#) 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 primitives
create #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