!!!Forth83 Benchmarks
Below is a collection of some Benchmarks for Forth83 systems like VolksForth.
I found most of these benchmarks on [comp.lang.forth|http://groups.google.com/group/comp.lang.forth], [Hans Bzemers|http://thebeezspeaks.blogspot.com/] [4th|http://www.xs4all.nl/~thebeez/4tH/foldtree.html] and Marcel Hendrix [benchmark collection|http://home.iae.nl/users/mhx/monsterbench.html]
[{TableOfContents }]
!!Integer Calculations
{{{
32000 constant intMax
variable intResult
: DoInt
1 dup intResult dup >r !
begin
dup intMax <
while
dup negate r@ +! 1+
dup r@ +! 1+
r@ @ over * r@ ! 1+
r@ @ over / r@ ! 1+
repeat
r> drop drop
;
}}}
!!Fibonacci 1
{{{
: fib1 ( n1 -- n2 )
dup 2 < if drop 1 exit then
dup 1- recursive
swap 2- recursive + ;
}}}
!!Fibonacci 2
{{{
: fib2 ( n1 -- n2 )
dup 2 < if drop 1 else
dup 1- recursive
swap 2 - recursive +
then ;
}}}
!!Forth Nesting Benchmark
{{{
\ Forth nesting (NEXT) Benchmark cas20101204
: bottom ;
: 1st bottom bottom ; : 2nd 1st 1st ; : 3rd 2nd 2nd ;
: 4th 3rd 3rd ; : 5th 4th 4th ; : 6th 5th 5th ;
: 7th 6th 6th ; : 8th 7th 7th ; : 9th 8th 8th ;
: 10th 9th 9th ; : 11th 10th 10th ; : 12th 11th 11th ;
: 13th 12th 12th ; : 14th 13th 13th ; : 15th 14th 14th ;
: 16th 15th 15th ; : 17th 16th 16th ; : 18th 17th 17th ;
: 19th 18th 18th ; : 20th 19th 19th ; : 21th 20th 20th ;
: 22th 21th 21th ; : 23th 22th 22th ; : 24th 23th 23th ;
: 25th 24th 24th ;
: 32million CR ." 32 million nest/unnest operations" 25th ;
: 1million CR ." 1 million nest/unnest operations" 20th ;
CR .( enter 1million or 32million )
}}}
!!Forth Memory Move Benchmark
{{{
\ Forth Memory Move Benchmark cas 20101204
8192 CONSTANT bufsize
VARIABLE buf1 HERE bufsize 1+ allot BUF1 !
VARIABLE buf2 HERE bufsize 1+ allot BUF2 !
: test-CMOVE 49 0 DO BUF1 @ BUF2 @ bufsize CMOVE LOOP ;
: test-CMOVE> 49 0 DO BUF2 @ BUF1 @ bufsize CMOVE> LOOP ;
: test-MOVE> 49 0 DO BUF1 @ BUF2 @ bufsize MOVE LOOP ;
: test-<MOVE 49 0 DO BUF2 @ BUF1 @ bufsize MOVE LOOP ;
}}}
!!count bits in byte
{{{
\ Forth Benchmark - count bits in byte cas 20101204
VARIABLE cnt
: countbits ( uu -- #bits )
cnt off
8 0 DO dup $01010101 and cnt +!
2/
LOOP drop
0 cnt 4 bounds DO i C@ + LOOP ;
: bench5
8192 DO I countbits . LOOP ;
}}}
!!Sieve Benchmark
{{{
\ Sieve Benchmark -- the classic Forth benchmark cas 20101204
8192 CONSTANT SIZE VARIABLE FLAGS 0 FLAGS ! SIZE ALLOT
: DO-PRIME
FLAGS SIZE 1 FILL ( set array )
0 ( 0 COUNT ) SIZE 0
DO FLAGS I + C@
IF I DUP + 3 + DUP I +
BEGIN DUP SIZE <
WHILE 0 OVER FLAGS + C! OVER + REPEAT
DROP DROP 1+
THEN
LOOP
. ." Primes" CR ;
}}}
!!Greatest Common Divisor
{{{
\ gcd - greatest common divisor cas 20101204
: gcd ( a b -- gcd )
OVER IF
BEGIN
DUP WHILE
2DUP U> IF SWAP THEN OVER -
REPEAT DROP ELSE
DUP IF NIP ELSE 2DROP 1 THEN
THEN ;
}}}
{{{
\ another gcd O(2) runtime speed cas 20101204
: gcd2 ( a b -- gcd )
2DUP D0= IF 2DROP 1 EXIT THEN
DUP 0= IF DROP EXIT THEN
SWAP DUP 0= IF DROP EXIT THEN
BEGIN 2DUP -
WHILE 2DUP < IF OVER -
ELSE SWAP OVER - SWAP
THEN
REPEAT NIP ;
}}}
!! Bench PI(n)
COPYRIGHT : Albert van der Horst FIG Chapter Holland
This program and modified versions thereof may be distributed
and used freely provided:
1. this copyright and a www reference to the original is kept
2. the following line states correctly either original or modified.
This version is : modified for Forth83.
The original version is available at http://home.hccnet.nl/a.w.m.van.der.horst/benchpin.frt
DESCRIPTION: This (highly recursive) function calculates PI(n), i.e. the number of primes less or equal to n. It doesn't use a sieve, nor does it inspect numbers larger than the square root of n for primeness. It may be used for benchmarking, because it takes considerable time for large numbers. It is one of the few highly recursive algorithms that actually calculate something sensible.
{{{
\ benchpin -- a highly recursiv function for PI(n) cas 20101204
: ?PRIME ( p -- flag )
>R R@ 4 U< IF R> DROPTRUE EXIT THEN
R@ 1 AND 0= IF R> DROP FALSE EXIT THEN
2 3 BEGIN
R@ OVER /MOD SWAP
0= IF R> DROP 2DROP FALSE EXIT THEN
OVER < IF R> DROP DROP TRUE EXIT THEN
2+ AGAIN ;
: DISMISS ( n1 p -- n2 )
>R R@ / DUP R@ < IF DROP R> 1 EXIT THEN
DUP R> 2 ?DO I ?PRIME IF OVER I RECURSIVE - THEN LOOP
SWAP DROP ;
: PI ( n1 -- n2 ) DUP >R 1- R@ 2 / 1- - 3 BEGIN
DUP DUP * R@ > 0= WHILE DUP ?PRIME IF CR DUP . ." is prime"
R@ OVER DISMISS 1- SWAP >R - R> THEN 2+ REPEAT DROP R> DROP ;
}}}