\ @(#) bench.fth 97/01/28 1.4
\ 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

\ 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


decimal

\ benchmark primitives
create #do 150000000   ,

: t1           #do @c 0      do                     loop ;
: t2  23 45    #do @c 0      do  swap               loop drop drop ;
: t3  23       #do @c 0      do  dup drop           loop drop ;
: t4  23 45    #do @c 0      do  over drop          loop drop drop ;
: t5           #do @c 0      do  23 45 + drop       loop ;
: t6  23       #do @c 0      do  >r r>              loop drop ;
: t7  23 45 67 #do @c 0      do  rot                loop drop drop drop ;
: t8           #do @c 0      do  23 2* drop         loop  ;
: t9           #do @c 0      do  23 5 /mod drop drop loop ;
: t10     #do  #do @c 0      do  dup @c drop        loop drop ;

: foo ( noop ) ;
: t11          #do @c 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 + @c +
   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 ----------------------------------
(error) value calc.answer
: answer ( n -- m )
   dup +
   [hex] a5a5 [decimal] xor
   1000 max
;
' answer to calc.answer
: bench3
   1500000 0
   DO
      i calc.answer execute drop
   LOOP
;

false [IF]
\ 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
;
[THEN]

\ SIEVE OF ERATOSTHENES from BYTE magazine -----------------------

DECIMAL 8190 CONSTANT TSIZE

TSIZE STRING FLAGS

: <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 DROP DROP 1+
      THEN
 LOOP       ;

: SIEVE  ." 10 iterations " CR  0   10 0
  DO     <SIEVE> swap drop
  LOOP   . ." primes " CR ;

\ 21.5 sec  Amiga Multi-Forth  Indirect Threaded
\ 8.82 sec  Amiga 1000 running JForth
\ ~5 sec  SGI Indy running pForthV9

[needs lib/timer.4th]
:noname . ." secs" cr time ; is timer-stop

timer-reset
." BENCHMARKS" cr
bench1
." bench 1: " .elapsed
bench2
." bench 2: " .elapsed
bench3
." bench 3: " .elapsed
sieve
." sieve  : " .elapsed

cr
." PRIMITIVES" cr
t1
." empty         : " .elapsed
t2
." swap          : " .elapsed
t3
." dup drop      : " .elapsed
t4
." over drop     : " .elapsed
t5
." + drop        : " .elapsed
t6
." >r r>         : " .elapsed
t7
." rot           : " .elapsed
t8
." 2* drop       : " .elapsed
t9
." /mod drop drop: " .elapsed
t10
." dup @ drop    : " .elapsed
t11
." call          : " .elapsed drop