/fth/bench.fth

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