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